-- --
------------------------------------------------------------------------------
-with Unchecked_Conversion;
-
package body Ada.Calendar.Arithmetic is
- use Leap_Sec_Ops;
+ --------------------------
+ -- Implementation Notes --
+ --------------------------
- Day_Duration : constant Duration := 86_400.0;
+ -- All operations in this package are target and time representation
+ -- independent, thus only one source file is needed for multiple targets.
---------
-- "+" --
---------
function "+" (Left : Time; Right : Day_Count) return Time is
+ R : constant Long_Integer := Long_Integer (Right);
begin
- return Left + Integer (Right) * Day_Duration;
+ return Arithmetic_Operations.Add (Left, R);
end "+";
function "+" (Left : Day_Count; Right : Time) return Time is
+ L : constant Long_Integer := Long_Integer (Left);
begin
- return Integer (Left) * Day_Duration + Right;
+ return Arithmetic_Operations.Add (Right, L);
end "+";
---------
---------
function "-" (Left : Time; Right : Day_Count) return Time is
+ R : constant Long_Integer := Long_Integer (Right);
begin
- return Left - Integer (Right) * Day_Duration;
+ return Arithmetic_Operations.Subtract (Left, R);
end "-";
function "-" (Left, Right : Time) return Day_Count is
- Days : Day_Count;
+ Days : Long_Integer;
Seconds : Duration;
- Leap_Seconds : Leap_Seconds_Count;
-
+ Leap_Seconds : Integer;
begin
- Difference (Left, Right, Days, Seconds, Leap_Seconds);
- return Days;
+ Arithmetic_Operations.Difference
+ (Left, Right, Days, Seconds, Leap_Seconds);
+ return Day_Count (Days);
end "-";
----------------
----------------
procedure Difference
- (Left, Right : Time;
+ (Left : Time;
+ Right : Time;
Days : out Day_Count;
Seconds : out Duration;
Leap_Seconds : out Leap_Seconds_Count)
is
- Diff : Duration;
- Earlier : Time;
- Later : Time;
- Leaps_Dur : Duration;
- Negate : Boolean;
- Next_Leap : Time;
- Secs_Diff : Long_Integer;
- Sub_Seconds : Duration;
-
+ Op_Days : Long_Integer;
+ Op_Leaps : Integer;
begin
- if Left >= Right then
- Later := Left;
- Earlier := Right;
- Negate := False;
- else
- Later := Right;
- Earlier := Left;
- Negate := True;
- end if;
-
- Diff := Later - Earlier;
-
- Cumulative_Leap_Secs (Earlier, Later, Leaps_Dur, Next_Leap);
-
- if Later >= Next_Leap then
- Leaps_Dur := Leaps_Dur + 1.0;
- end if;
-
- Diff := Diff - Leaps_Dur;
-
- 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 (Diff);
- Secs_Diff := Long_Integer (D_As_Int / Small_Div);
- Sub_Seconds := To_Duration (D_As_Int rem Small_Div);
- end;
-
- Days := Day_Count (Secs_Diff / 86_400);
- Seconds := Duration (Secs_Diff mod 86_400) + Sub_Seconds;
- Leap_Seconds := Leap_Seconds_Count (Leaps_Dur);
-
- if Negate then
- Days := -Days;
- Seconds := -Seconds;
- Leap_Seconds := -Leap_Seconds;
- end if;
+ Arithmetic_Operations.Difference
+ (Left, Right, Op_Days, Seconds, Op_Leaps);
+ Days := Day_Count (Op_Days);
+ Leap_Seconds := Leap_Seconds_Count (Op_Leaps);
end Difference;
end Ada.Calendar.Arithmetic;
-- --
-- S p e c --
-- --
--- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- --
------------------------------------------------------------------------------
+-- This package provides arithmetic operations of time values using days
+-- and leap seconds. Ada.Calendar.Arithmetic is defined in the Ada 2005
+-- RM (9.6.1).
+
package Ada.Calendar.Arithmetic is
-- Arithmetic on days:
+ -- Rough estimate on the number of days over the range of Ada time
+
type Day_Count is range
-(366 * (1 + Year_Number'Last - Year_Number'First))
..
+(366 * (1 + Year_Number'Last - Year_Number'First));
+ -- Negative leap seconds occur whenever the astronomical time is faster
+ -- than the atomic time or as a result of Difference when Left < Right.
+
subtype Leap_Seconds_Count is Integer range -2047 .. 2047;
procedure Difference
- (Left, Right : Time;
+ (Left : Time;
+ Right : Time;
Days : out Day_Count;
Seconds : out Duration;
Leap_Seconds : out Leap_Seconds_Count);
+ -- Returns the difference between Left and Right. Days is the number of
+ -- days of difference, Seconds is the remainder seconds of difference
+ -- excluding leap seconds, and Leap_Seconds is the number of leap seconds.
+ -- If Left < Right, then Seconds <= 0.0, Days <= 0, and Leap_Seconds <= 0,
+ -- otherwise all values are nonnegative. The absolute value of Seconds is
+ -- always less than 86_400.0. For the returned values, if Days = 0, then
+ -- Seconds + Duration (Leap_Seconds) = Calendar."-" (Left, Right)
+
+ function "+" (Left : Time; Right : Day_Count) return Time;
+ function "+" (Left : Day_Count; Right : Time) return Time;
+ -- Adds a number of days to a time value. Time_Error is raised if the
+ -- result is not representable as a value of type Time.
+
+ function "-" (Left : Time; Right : Day_Count) return Time;
+ -- Subtracts a number of days from a time value. Time_Error is raised if
+ -- the result is not representable as a value of type Time.
- function "+" (Left : Time; Right : Day_Count) return Time;
- function "+" (Left : Day_Count; Right : Time) return Time;
- function "-" (Left : Time; Right : Day_Count) return Time;
- function "-" (Left, Right : Time) return Day_Count;
+ function "-" (Left : Time; Right : Time) return Day_Count;
+ -- Subtracts two time values, and returns the number of days between them.
+ -- This is the same value that Difference would return in Days.
end Ada.Calendar.Arithmetic;
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2005, AdaCore --
+-- Copyright (C) 1995-2006, AdaCore --
-- --
-- GNARL 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- --
use System.Traces;
- -- Earlier, the following operations were implemented using
- -- System.Time_Operations. The idea was to avoid sucking in the tasking
- -- packages. This did not work. Logically, we can't have it both ways.
- -- There is no way to implement time delays that will have correct task
- -- semantics without reference to the tasking run-time system.
- -- To achieve this goal, we now use soft links.
+ -- Earlier, System.Time_Opeations was used to implement the following
+ -- operations. The idea was to avoid sucking in the tasking packages. This
+ -- did not work. Logically, we can't have it both ways. There is no way to
+ -- implement time delays that will have correct task semantics without
+ -- reference to the tasking run-time system. To achieve this goal, we now
+ -- use soft links.
-----------------------
-- Local Subprograms --
function To_Duration (T : Time) return Duration is
begin
- return Duration (T);
+ -- Since time has multiple representations on different platforms, a
+ -- target independent operation in Ada.Calendar is used to perform
+ -- this conversion.
+
+ return Delays_Operations.To_Duration (T);
end To_Duration;
begin
- -- Set up the Timed_Delay soft link to the non tasking version
- -- if it has not been already set.
+ -- Set up the Timed_Delay soft link to the non tasking version if it has
+ -- not been already set.
- -- If tasking is present, Timed_Delay has already set this soft
- -- link, or this will be overriden during the elaboration of
+ -- If tasking is present, Timed_Delay has already set this soft link, or
+ -- this will be overriden during the elaboration of
-- System.Tasking.Initialization
if SSL.Timed_Delay = null then
SSL.Timed_Delay := Timed_Delay_NT'Access;
end if;
+
end Ada.Calendar.Delays;
with System.Aux_DEC; use System.Aux_DEC;
+with Ada.Unchecked_Conversion;
+
package body Ada.Calendar is
- ------------------------------
- -- Use of Pragma Unsuppress --
- ------------------------------
+ --------------------------
+ -- Implementation Notes --
+ --------------------------
- -- 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.
+ -- Variables of type Ada.Calendar.Time have suffix _S or _M to denote
+ -- units of seconds or milis.
- ------------------------
- -- Local Declarations --
- ------------------------
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
- Ada_Year_Min : constant := 1901;
- Ada_Year_Max : constant := 2099;
+ function All_Leap_Seconds return Natural;
+ -- Return the number of all leap seconds allocated so far
+
+ procedure Cumulative_Leap_Seconds
+ (Start_Date : Time;
+ End_Date : Time;
+ Elapsed_Leaps : out Natural;
+ Next_Leap_Sec : out Time);
+ -- Elapsed_Leaps is the sum of the leap seconds that have occured on or
+ -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
+ -- represents the next leap second occurence on or after End_Date. If there
+ -- are no leaps seconds after End_Date, After_Last_Leap is returned.
+ -- After_Last_Leap can be used as End_Date to count all the leap seconds
+ -- that have occured on or after Start_Date.
+ --
+ -- Note: Any sub seconds of Start_Date and End_Date are discarded before
+ -- the calculations are done. For instance: if 113 seconds is a leap
+ -- second (it isn't) and 113.5 is input as an End_Date, the leap second
+ -- at 113 will not be counted in Leaps_Between, but it will be returned
+ -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
+ -- a leap second, the comparison should be:
+ --
+ -- End_Date >= Next_Leap_Sec;
+ --
+ -- After_Last_Leap is designed so that this comparison works without
+ -- having to first check if Next_Leap_Sec is a valid leap second.
+
+ function To_Duration (T : Time) return Duration;
+ function To_Relative_Time (D : Duration) return Time;
+ -- It is important to note that duration's fractional part denotes nano
+ -- seconds while the units of Time are 100 nanoseconds. If a regular
+ -- Unchecked_Conversion was employed, the resulting values would be off
+ -- by 100.
- -- Some basic constants used throughout
+ ---------------------
+ -- Local Constants --
+ ---------------------
- function To_Relative_Time (D : Duration) return Time;
+ After_Last_Leap : constant Time := Time'Last;
+ N_Leap_Seconds : constant Natural := 23;
- function To_Relative_Time (D : Duration) return Time is
- begin
- return Time (Long_Integer'Integer_Value (D) / 100);
- end To_Relative_Time;
+ Cumulative_Days_Before_Month :
+ constant array (Month_Number) of Natural :=
+ (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
+
+ Leap_Second_Times : array (1 .. N_Leap_Seconds) of Time;
+ -- Each value represents a time value which is one second before a leap
+ -- second occurence. This table is populated during the elaboration of
+ -- Ada.Calendar.
---------
-- "+" --
function "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
+
+ Ada_High_And_Leaps : constant Time :=
+ Ada_High + Time (All_Leap_Seconds) * Mili;
+ Result : constant Time := Left + To_Relative_Time (Right);
+
begin
- return (Left + To_Relative_Time (Right));
+ if Result < Ada_Low
+ or else Result >= Ada_High_And_Leaps
+ then
+ raise Time_Error;
+ end if;
+ return Result;
exception
when Constraint_Error =>
raise Time_Error;
function "+" (Left : Duration; Right : Time) return Time is
pragma Unsuppress (Overflow_Check);
begin
- return (To_Relative_Time (Left) + Right);
-
+ return Right + Left;
exception
when Constraint_Error =>
raise Time_Error;
-- "-" --
---------
- function "-" (Left : Time; Right : Duration) return Time is
+ function "-" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
+
+ Ada_High_And_Leaps : constant Time :=
+ Ada_High + Time (All_Leap_Seconds) * Mili;
+ Result : constant Time := Left - To_Relative_Time (Right);
+
begin
- return Left - To_Relative_Time (Right);
+ if Result < Ada_Low
+ or else Result >= Ada_High_And_Leaps
+ then
+ raise Time_Error;
+ end if;
+
+ return Result;
exception
when Constraint_Error =>
function "-" (Left : Time; Right : Time) return Duration is
pragma Unsuppress (Overflow_Check);
+
+ Diff : constant Time := Left - Right;
+ Dur_High : constant Time := Time (Duration'Last) * 100;
+ Dur_Low : constant Time := Time (Duration'First) * 100;
+
begin
- return Duration'Fixed_Value
- ((Long_Integer (Left) - Long_Integer (Right)) * 100);
+ if Diff < Dur_Low
+ or else Diff > Dur_High
+ then
+ raise Time_Error;
+ end if;
+
+ return To_Duration (Diff);
exception
when Constraint_Error =>
return Long_Integer (Left) >= Long_Integer (Right);
end ">=";
+ ----------------------
+ -- All_Leap_Seconds --
+ ----------------------
+
+ function All_Leap_Seconds return Natural is
+ begin
+ return N_Leap_Seconds;
+ end All_Leap_Seconds;
+
-----------
-- Clock --
-----------
- -- The Ada.Calendar.Clock function gets the time.
- -- Note that on other targets a soft-link is used to get a different clock
- -- depending whether tasking is used or not. On VMS this isn't needed
- -- since all clock calls end up using SYS$GETTIM, so call the
- -- OS_Primitives version for efficiency.
-
function Clock return Time is
+ Elapsed_Leaps : Natural;
+ Next_Leap : Time;
+ Now : constant Time := Time (OSP.OS_Clock);
+ Rounded_Now : constant Time := Now - (Now mod Mili);
+
begin
- return Time (OSP.OS_Clock);
+ -- Note that on other targets a soft-link is used to get a different
+ -- clock depending whether tasking is used or not. On VMS this isn't
+ -- needed since all clock calls end up using SYS$GETTIM, so call the
+ -- OS_Primitives version for efficiency.
+
+ -- Determine the number of leap seconds elapsed until this moment
+
+ Cumulative_Leap_Seconds (Ada_Low, Now, Elapsed_Leaps, Next_Leap);
+
+ -- It is possible that OS_Clock falls exactly on a leap second
+
+ if Rounded_Now = Next_Leap then
+ return Now + Time (Elapsed_Leaps + 1) * Mili;
+ else
+ return Now + Time (Elapsed_Leaps) * Mili;
+ end if;
end Clock;
+ -----------------------------
+ -- Cumulative_Leap_Seconds --
+ -----------------------------
+
+ procedure Cumulative_Leap_Seconds
+ (Start_Date : Time;
+ End_Date : Time;
+ Elapsed_Leaps : out Natural;
+ Next_Leap_Sec : out Time)
+ is
+ End_Index : Positive;
+ End_T : Time := End_Date;
+ Start_Index : Positive;
+ Start_T : Time := Start_Date;
+
+ begin
+ pragma Assert (Start_Date >= End_Date);
+
+ Next_Leap_Sec := After_Last_Leap;
+
+ -- Make sure that the end date does not excede the upper bound
+ -- of Ada time.
+
+ if End_Date > Ada_High then
+ End_T := Ada_High;
+ end if;
+
+ -- Remove the sub seconds from both dates
+
+ Start_T := Start_T - (Start_T mod Mili);
+ End_T := End_T - (End_T mod Mili);
+
+ -- Some trivial cases
+
+ if End_T < Leap_Second_Times (1) then
+ Elapsed_Leaps := 0;
+ Next_Leap_Sec := Leap_Second_Times (1);
+ return;
+
+ elsif Start_T > Leap_Second_Times (N_Leap_Seconds) then
+ Elapsed_Leaps := 0;
+ Next_Leap_Sec := After_Last_Leap;
+ return;
+ end if;
+
+ -- Perform the calculations only if the start date is within the leap
+ -- second occurences table.
+
+ if Start_T <= Leap_Second_Times (N_Leap_Seconds) then
+
+ -- 1 2 N - 1 N
+ -- +----+----+-- . . . --+-------+---+
+ -- | T1 | T2 | | N - 1 | N |
+ -- +----+----+-- . . . --+-------+---+
+ -- ^ ^
+ -- | Start_Index | End_Index
+ -- +-------------------+
+ -- Leaps_Between
+
+ -- The idea behind the algorithm is to iterate and find two closest
+ -- dates which are after Start_T and End_T. Their corresponding index
+ -- difference denotes the number of leap seconds elapsed.
+
+ Start_Index := 1;
+ loop
+ exit when Leap_Second_Times (Start_Index) >= Start_T;
+ Start_Index := Start_Index + 1;
+ end loop;
+
+ End_Index := Start_Index;
+ loop
+ exit when End_Index > N_Leap_Seconds
+ or else Leap_Second_Times (End_Index) >= End_T;
+ End_Index := End_Index + 1;
+ end loop;
+
+ if End_Index <= N_Leap_Seconds then
+ Next_Leap_Sec := Leap_Second_Times (End_Index);
+ end if;
+
+ Elapsed_Leaps := End_Index - Start_Index;
+
+ else
+ Elapsed_Leaps := 0;
+ end if;
+ end Cumulative_Leap_Seconds;
+
---------
-- Day --
---------
function Day (Date : Time) return Day_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DD;
+ Split (Date, Y, M, D, S);
+ return D;
end Day;
+ -------------
+ -- Is_Leap --
+ -------------
+
+ function Is_Leap (Year : Year_Number) return Boolean is
+ begin
+ -- Leap centenial years
+
+ if Year mod 400 = 0 then
+ return True;
+
+ -- Non-leap centenial years
+
+ elsif Year mod 100 = 0 then
+ return False;
+
+ -- Regular years
+
+ else
+ return Year mod 4 = 0;
+ end if;
+ end Is_Leap;
+
-----------
-- Month --
-----------
function Month (Date : Time) return Month_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DM;
+ Split (Date, Y, M, D, S);
+ return M;
end Month;
-------------
-------------
function Seconds (Date : Time) return Day_Duration is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DS;
+ Split (Date, Y, M, D, S);
+ return S;
end Seconds;
-----------
Day : out Day_Number;
Seconds : out Day_Duration)
is
- procedure Numtim (
- Status : out Unsigned_Longword;
- Timbuf : out Unsigned_Word_Array;
- Timadr : Time);
-
- pragma Interface (External, Numtim);
-
- pragma Import_Valued_Procedure (Numtim, "SYS$NUMTIM",
- (Unsigned_Longword, Unsigned_Word_Array, Time),
- (Value, Reference, Reference));
-
- Status : Unsigned_Longword;
- Timbuf : Unsigned_Word_Array (1 .. 7);
-
- Subsecs : constant Time := Date mod 10_000_000;
- Date_Secs : constant Time := Date - Subsecs;
+ H : Integer;
+ M : Integer;
+ Se : Integer;
+ Ss : Duration;
+ Le : Boolean;
begin
- Numtim (Status, Timbuf, Date_Secs);
+ Formatting_Operations.Split
+ (Date, Year, Month, Day, Seconds, H, M, Se, Ss, Le, 0);
- if Status mod 2 /= 1
- or else Timbuf (1) not in Ada_Year_Min .. Ada_Year_Max
+ -- Validity checks
+
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else not Seconds'Valid
then
raise Time_Error;
end if;
-
- Seconds := Day_Duration (Timbuf (6)
- + 60 * (Timbuf (5) + 60 * Timbuf (4)))
- + Duration (Subsecs) / 10_000_000.0;
-
- Day := Integer (Timbuf (3));
- Month := Integer (Timbuf (2));
- Year := Integer (Timbuf (1));
end Split;
- -----------------------
- -- Split_With_Offset --
- -----------------------
-
- procedure Split_With_Offset
- (Date : Time;
- Year : out Year_Number;
- Month : out Month_Number;
- Day : out Day_Number;
- Seconds : out Day_Duration;
- Offset : out Long_Integer)
- is
- begin
- raise Unimplemented;
- end Split_With_Offset;
-
-------------
-- Time_Of --
-------------
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
- Seconds : Day_Duration := 0.0)
- return Time
+ Seconds : Day_Duration := 0.0) return Time
is
+ -- The values in the following constants are irrelevant, they are just
+ -- placeholders; the choice of constructing a Day_Duration value is
+ -- controlled by the Use_Day_Secs flag.
- procedure Cvt_Vectim (
- Status : out Unsigned_Longword;
- Input_Time : Unsigned_Word_Array;
- Resultant_Time : out Time);
-
- pragma Interface (External, Cvt_Vectim);
-
- pragma Import_Valued_Procedure (Cvt_Vectim, "LIB$CVT_VECTIM",
- (Unsigned_Longword, Unsigned_Word_Array, Time),
- (Value, Reference, Reference));
-
- Status : Unsigned_Longword;
- Timbuf : Unsigned_Word_Array (1 .. 7);
- Date : Time;
- Int_Secs : Integer;
- Day_Hack : Boolean := False;
- Subsecs : Day_Duration;
+ H : constant Integer := 1;
+ M : constant Integer := 1;
+ Se : constant Integer := 1;
+ Ss : constant Duration := 0.1;
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
+ 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;
-
- -- Truncate seconds value by subtracting 0.5 and rounding,
- -- but be careful with 0.0 since that will give -1.0 unless
- -- it is treated specially.
-
- if Seconds > 0.0 then
- Int_Secs := Integer (Seconds - 0.5);
- else
- Int_Secs := Integer (Seconds);
- end if;
-
- Subsecs := Seconds - Day_Duration (Int_Secs);
-
- -- Cvt_Vectim barfs on the largest Day_Duration, so trick it by
- -- setting it to zero and then adding the difference after conversion.
-
- if Int_Secs = 86_400 then
- Int_Secs := 0;
- Day_Hack := True;
+ raise Time_Error;
end if;
- Timbuf (7) := 0;
- Timbuf (6) := Unsigned_Word (Int_Secs mod 60);
- Timbuf (5) := Unsigned_Word ((Int_Secs / 60) mod 60);
- Timbuf (4) := Unsigned_Word (Int_Secs / 3600);
- Timbuf (3) := Unsigned_Word (Day);
- Timbuf (2) := Unsigned_Word (Month);
- Timbuf (1) := Unsigned_Word (Year);
+ return
+ Formatting_Operations.Time_Of
+ (Year, Month, Day, Seconds, H, M, Se, Ss,
+ Leap_Sec => False,
+ Leap_Checks => False,
+ Use_Day_Secs => True,
+ Time_Zone => 0);
+ end Time_Of;
- Cvt_Vectim (Status, Timbuf, Date);
+ -----------------
+ -- To_Duration --
+ -----------------
- if Status mod 2 /= 1 then
- raise Time_Error;
- end if;
+ function To_Duration (T : Time) return Duration is
+ function Time_To_Duration is
+ new Ada.Unchecked_Conversion (Time, Duration);
+ begin
+ return Time_To_Duration (T * 100);
+ end To_Duration;
- if Day_Hack then
- Date := Date + 10_000_000 * 86_400;
- end if;
+ ----------------------
+ -- To_Relative_Time --
+ ----------------------
- Date := Date + Time (10_000_000.0 * Subsecs);
- return Date;
- end Time_Of;
+ function To_Relative_Time (D : Duration) return Time is
+ function Duration_To_Time is
+ new Ada.Unchecked_Conversion (Duration, Time);
+ begin
+ return Duration_To_Time (D / 100.0);
+ end To_Relative_Time;
----------
-- Year --
----------
function Year (Date : Time) return Year_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DY;
+ Split (Date, Y, M, D, S);
+ return Y;
end Year;
- -------------------
- -- Leap_Sec_Ops --
- -------------------
+ -- The following packages assume that Time is a Long_Integer, the units
+ -- are 100 nanoseconds and the starting point in the VMS Epoch.
- -- The package that is used by the Ada 2005 children of Ada.Calendar:
- -- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
+ ---------------------------
+ -- Arithmetic_Operations --
+ ---------------------------
- package body Leap_Sec_Ops is
+ package body Arithmetic_Operations is
- --------------------------
- -- Cumulative_Leap_Secs --
- --------------------------
+ ---------
+ -- Add --
+ ---------
- procedure Cumulative_Leap_Secs
- (Start_Date : Time;
- End_Date : Time;
- Leaps_Between : out Duration;
- Next_Leap_Sec : out Time)
+ function Add (Date : Time; Days : Long_Integer) return Time is
+ Ada_High_And_Leaps : constant Time :=
+ Ada_High + Time (All_Leap_Seconds) * Mili;
+ begin
+ if Days = 0 then
+ return Date;
+
+ elsif Days < 0 then
+ return Subtract (Date, abs (Days));
+
+ else
+ declare
+ Result : constant Time := Date + Time (Days) * Milis_In_Day;
+
+ begin
+ -- The result excedes the upper bound of Ada time
+
+ if Result >= Ada_High_And_Leaps then
+ raise Time_Error;
+ end if;
+
+ return Result;
+ end;
+ end if;
+
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end Add;
+
+ ----------------
+ -- Difference --
+ ----------------
+
+ procedure Difference
+ (Left : Time;
+ Right : Time;
+ Days : out Long_Integer;
+ Seconds : out Duration;
+ Leap_Seconds : out Integer)
is
+ Mili_F : constant Duration := 10_000_000.0;
+
+ Diff_M : Time;
+ Diff_S : Time;
+ Earlier : Time;
+ Elapsed_Leaps : Natural;
+ Later : Time;
+ Negate : Boolean;
+ Next_Leap : Time;
+ Sub_Seconds : Duration;
+
begin
- raise Unimplemented;
- end Cumulative_Leap_Secs;
+ -- This classification is necessary in order to avoid a Time_Error
+ -- being raised by the arithmetic operators in Ada.Calendar.
+
+ if Left >= Right then
+ Later := Left;
+ Earlier := Right;
+ Negate := False;
+ else
+ Later := Right;
+ Earlier := Left;
+ Negate := True;
+ end if;
+
+ -- First process the leap seconds
+
+ Cumulative_Leap_Seconds (Earlier, Later, Elapsed_Leaps, Next_Leap);
+
+ if Later >= Next_Leap then
+ Elapsed_Leaps := Elapsed_Leaps + 1;
+ end if;
+
+ Diff_M := Later - Earlier - Time (Elapsed_Leaps) * Mili;
+
+ -- Sub second processing
+
+ Sub_Seconds := Duration (Diff_M mod Mili) / Mili_F;
+
+ -- Convert to seconds. Note that his action eliminates the sub
+ -- seconds automatically.
+
+ Diff_S := Diff_M / Mili;
+
+ Days := Long_Integer (Diff_S / Secs_In_Day);
+ Seconds := Duration (Diff_S mod Secs_In_Day) + Sub_Seconds;
+ Leap_Seconds := Integer (Elapsed_Leaps);
+
+ if Negate then
+ Days := -Days;
+ Seconds := -Seconds;
+ Leap_Seconds := -Leap_Seconds;
+ end if;
+ end Difference;
+
+ --------------
+ -- Subtract --
+ --------------
+
+ function Subtract (Date : Time; Days : Long_Integer) return Time is
+ begin
+ if Days = 0 then
+ return Date;
+
+ elsif Days < 0 then
+ return Add (Date, abs (Days));
+
+ else
+ declare
+ Days_T : constant Time := Time (Days) * Milis_In_Day;
+ Result : constant Time := Date - Days_T;
+
+ begin
+ -- Subtracting a larger number of days from a smaller time
+ -- value will cause wrap around since time is a modular type.
+ -- Also the result may be lower than the start of Ada time.
+
+ if Date < Days_T
+ or Result < Ada_Low
+ then
+ raise Time_Error;
+ end if;
+
+ return Date - Days_T;
+ end;
+ end if;
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end Subtract;
+ end Arithmetic_Operations;
+
+ ---------------------------
+ -- Formatting_Operations --
+ ---------------------------
+
+ package body Formatting_Operations is
+
+ -----------------
+ -- Day_Of_Week --
+ -----------------
+
+ function Day_Of_Week (Date : Time) return Integer is
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
+
+ Day_Count : Long_Integer;
+ Midday_Date_S : Time;
+
+ begin
+ Split (Date, Y, M, D, S);
+
+ -- Build a time value in the middle of the same day and convert the
+ -- time value to seconds.
+
+ Midday_Date_S := Time_Of (Y, M, D, 43_200.0) / Mili;
+
+ -- Count the number of days since the start of VMS time. 1858-11-17
+ -- was a Wednesday.
+
+ Day_Count := Long_Integer (Midday_Date_S / Secs_In_Day) + 2;
+
+ return Integer (Day_Count mod 7);
+ end Day_Of_Week;
+
+ -----------
+ -- Split --
+ -----------
+
+ procedure Split
+ (Date : Time;
+ Year : out Year_Number;
+ Month : out Month_Number;
+ Day : out Day_Number;
+ Day_Secs : out Day_Duration;
+ Hour : out Integer;
+ Minute : out Integer;
+ Second : out Integer;
+ Sub_Sec : out Duration;
+ Leap_Sec : out Boolean;
+ Time_Zone : Long_Integer)
+ is
+ procedure Numtim
+ (Status : out Unsigned_Longword;
+ Timbuf : out Unsigned_Word_Array;
+ Timadr : Time);
+
+ pragma Interface (External, Numtim);
+
+ pragma Import_Valued_Procedure
+ (Numtim, "SYS$NUMTIM",
+ (Unsigned_Longword, Unsigned_Word_Array, Time),
+ (Value, Reference, Reference));
+
+ Status : Unsigned_Longword;
+ Timbuf : Unsigned_Word_Array (1 .. 7);
+
+ Ada_Min_Year : constant := 1901;
+ Ada_Max_Year : constant := 2399;
+ Mili_F : constant Duration := 10_000_000.0;
+
+ Abs_Time_Zone : Time;
+ Elapsed_Leaps : Natural;
+ Modified_Date_M : Time;
+ Next_Leap_M : Time;
+ Rounded_Date_M : Time;
+
+ begin
+ Modified_Date_M := Date;
+
+ -- Step 1: Leap seconds processing
+
+ Cumulative_Leap_Seconds (Ada_Low, Date, Elapsed_Leaps, Next_Leap_M);
+
+ Rounded_Date_M := Modified_Date_M - (Modified_Date_M mod Mili);
+ Leap_Sec := Rounded_Date_M = Next_Leap_M;
+ Modified_Date_M := Modified_Date_M - Time (Elapsed_Leaps) * Mili;
+
+ if Leap_Sec then
+ Modified_Date_M := Modified_Date_M - Time (1) * Mili;
+ end if;
+
+ -- Step 2: Time zone processing
+
+ if Time_Zone /= 0 then
+ Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Mili;
+
+ if Time_Zone < 0 then
+ Modified_Date_M := Modified_Date_M - Abs_Time_Zone;
+ else
+ Modified_Date_M := Modified_Date_M + Abs_Time_Zone;
+ end if;
+ end if;
+
+ -- After the leap seconds and time zone have been accounted for,
+ -- the date should be within the bounds of Ada time.
+
+ if Modified_Date_M < Ada_Low
+ or else Modified_Date_M >= Ada_High
+ then
+ raise Time_Error;
+ end if;
+
+ -- Step 3: Sub second processing
+
+ Sub_Sec := Duration (Modified_Date_M mod Mili) / Mili_F;
+
+ -- Drop the sub seconds
+
+ Modified_Date_M := Modified_Date_M - (Modified_Date_M mod Mili);
+
+ -- Step 4: VMS system call
+
+ Numtim (Status, Timbuf, Modified_Date_M);
+
+ if Status mod 2 /= 1
+ or else Timbuf (1) not in Ada_Min_Year .. Ada_Max_Year
+ then
+ raise Time_Error;
+ end if;
+
+ -- Step 5: Time components processing
+
+ Year := Year_Number (Timbuf (1));
+ Month := Month_Number (Timbuf (2));
+ Day := Day_Number (Timbuf (3));
+ Hour := Integer (Timbuf (4));
+ Minute := Integer (Timbuf (5));
+ Second := Integer (Timbuf (6));
- ----------------------
- -- All_Leap_Seconds --
- ----------------------
+ Day_Secs := Day_Duration (Hour * 3_600) +
+ Day_Duration (Minute * 60) +
+ Day_Duration (Second) +
+ Sub_Sec;
+ end Split;
+
+ -------------
+ -- Time_Of --
+ -------------
+
+ function Time_Of
+ (Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Day_Secs : Day_Duration;
+ Hour : Integer;
+ Minute : Integer;
+ Second : Integer;
+ Sub_Sec : Duration;
+ Leap_Sec : Boolean;
+ Leap_Checks : Boolean;
+ Use_Day_Secs : Boolean;
+ Time_Zone : Long_Integer) return Time
+ is
+ procedure Cvt_Vectim
+ (Status : out Unsigned_Longword;
+ Input_Time : Unsigned_Word_Array;
+ Resultant_Time : out Time);
+
+ pragma Interface (External, Cvt_Vectim);
+
+ pragma Import_Valued_Procedure
+ (Cvt_Vectim, "LIB$CVT_VECTIM",
+ (Unsigned_Longword, Unsigned_Word_Array, Time),
+ (Value, Reference, Reference));
+
+ Status : Unsigned_Longword;
+ Timbuf : Unsigned_Word_Array (1 .. 7);
+
+ Mili_F : constant := 10_000_000.0;
+
+ Ada_High_And_Leaps : constant Time :=
+ Ada_High + Time (All_Leap_Seconds) * Mili;
+
+ H : Integer := Hour;
+ Mi : Integer := Minute;
+ Se : Integer := Second;
+ Su : Duration := Sub_Sec;
+
+ Abs_Time_Zone : Time;
+ Adjust_Day : Boolean := False;
+ Elapsed_Leaps : Natural;
+ Int_Day_Secs : Integer;
+ Next_Leap_M : Time;
+ Result_M : Time;
+ Rounded_Result_M : Time;
- function All_Leap_Seconds return Duration is
begin
- raise Unimplemented;
- return 0.0;
- end All_Leap_Seconds;
+ -- No validity checks are performed on the input values since it is
+ -- assumed that the called has already performed them.
+
+ -- Step 1: Hour, minute, second and sub second processing
+
+ if Use_Day_Secs then
+
+ -- A day seconds value of 86_400 designates a new day. The time
+ -- components are reset to zero, but an additional day will be
+ -- added after the system call.
+
+ if Day_Secs = 86_400.0 then
+ Adjust_Day := True;
+ H := 0;
+ Mi := 0;
+ Se := 0;
+
+ else
+ -- Sub second extraction
+
+ if Day_Secs > 0.0 then
+ Int_Day_Secs := Integer (Day_Secs - 0.5);
+ else
+ Int_Day_Secs := Integer (Day_Secs);
+ end if;
+
+ H := Int_Day_Secs / 3_600;
+ Mi := (Int_Day_Secs / 60) mod 60;
+ Se := Int_Day_Secs mod 60;
+ Su := Day_Secs - Duration (Int_Day_Secs);
+ end if;
+ end if;
+
+ -- Step 2: System call to VMS
+
+ Timbuf (1) := Unsigned_Word (Year);
+ Timbuf (2) := Unsigned_Word (Month);
+ Timbuf (3) := Unsigned_Word (Day);
+ Timbuf (4) := Unsigned_Word (H);
+ Timbuf (5) := Unsigned_Word (Mi);
+ Timbuf (6) := Unsigned_Word (Se);
+ Timbuf (7) := 0;
+
+ Cvt_Vectim (Status, Timbuf, Result_M);
+
+ if Status mod 2 /= 1 then
+ raise Time_Error;
+ end if;
+
+ -- Step 3: Potential day adjustment
+
+ if Use_Day_Secs
+ and then Adjust_Day
+ then
+ Result_M := Result_M + Milis_In_Day;
+ end if;
+
+ -- Step 4: Sub second adjustment
+
+ Result_M := Result_M + Time (Su * Mili_F);
+
+ -- Step 5: Time zone processing
+
+ if Time_Zone /= 0 then
+ Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Mili;
+
+ if Time_Zone < 0 then
+ Result_M := Result_M + Abs_Time_Zone;
+ else
+ Result_M := Result_M - Abs_Time_Zone;
+ end if;
+ end if;
+
+ -- Step 6: Leap seconds processing
- -- Start of processing in package Leap_Sec_Ops
+ Cumulative_Leap_Seconds
+ (Ada_Low, Result_M, Elapsed_Leaps, Next_Leap_M);
+
+ Result_M := Result_M + Time (Elapsed_Leaps) * Mili;
+
+ -- An Ada 2005 caller requesting an explicit leap second or an Ada
+ -- 95 caller accounting for an invisible leap second.
+
+ Rounded_Result_M := Result_M - (Result_M mod Mili);
+
+ if Leap_Sec
+ or else Rounded_Result_M = Next_Leap_M
+ then
+ Result_M := Result_M + Time (1) * Mili;
+ Rounded_Result_M := Rounded_Result_M + Time (1) * Mili;
+ end if;
+
+ -- Leap second validity check
+
+ if Leap_Checks
+ and then Leap_Sec
+ and then Rounded_Result_M /= Next_Leap_M
+ then
+ raise Time_Error;
+ end if;
+
+ -- Bounds check
+
+ if Result_M < Ada_Low
+ or else Result_M >= Ada_High_And_Leaps
+ then
+ raise Time_Error;
+ end if;
+
+ return Result_M;
+ end Time_Of;
+ end Formatting_Operations;
+
+ ---------------------------
+ -- Time_Zones_Operations --
+ ---------------------------
+
+ package body Time_Zones_Operations is
+
+ ---------------------
+ -- UTC_Time_Offset --
+ ---------------------
+
+ function UTC_Time_Offset (Date : Time) return Long_Integer is
+ -- Formal parameter Date is here for interfacing, but is never
+ -- actually used.
+
+ pragma Unreferenced (Date);
+
+ function get_gmtoff return Long_Integer;
+ pragma Import (C, get_gmtoff, "get_gmtoff");
+
+ begin
+ -- VMS is not capable of determining the time zone in some past or
+ -- future point in time denoted by Date, thus the current time zone
+ -- is retrieved.
+
+ return get_gmtoff;
+ end UTC_Time_Offset;
+ end Time_Zones_Operations;
+
+-- Start of elaboration code for Ada.Calendar
+
+begin
+ -- Population of the leap seconds table
+
+ declare
+ type Leap_Second_Date is record
+ Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ end record;
+
+ Leap_Second_Dates :
+ constant array (1 .. N_Leap_Seconds) of Leap_Second_Date :=
+ ((1972, 6, 30), (1972, 12, 31), (1973, 12, 31), (1974, 12, 31),
+ (1975, 12, 31), (1976, 12, 31), (1977, 12, 31), (1978, 12, 31),
+ (1979, 12, 31), (1981, 6, 30), (1982, 6, 30), (1983, 6, 30),
+ (1985, 6, 30), (1987, 12, 31), (1989, 12, 31), (1990, 12, 31),
+ (1992, 6, 30), (1993, 6, 30), (1994, 6, 30), (1995, 12, 31),
+ (1997, 6, 30), (1998, 12, 31), (2005, 12, 31));
+
+ Ada_Min_Year : constant Year_Number := Year_Number'First;
+ Days_In_Four_Years : constant := 365 * 3 + 366;
+ VMS_Days : constant := 10 * 366 + 32 * 365 + 45;
+
+ Days : Natural;
+ Leap : Leap_Second_Date;
+ Years : Natural;
begin
- null;
- end Leap_Sec_Ops;
+ for Index in 1 .. N_Leap_Seconds loop
+ Leap := Leap_Second_Dates (Index);
+
+ -- Calculate the number of days from the start of Ada time until
+ -- the current leap second occurence. Non-leap centenial years
+ -- are not accounted for in these calculations since there are
+ -- no leap seconds after 2100 yet.
+
+ Years := Leap.Year - Ada_Min_Year;
+ Days := (Years / 4) * Days_In_Four_Years;
+ Years := Years mod 4;
+
+ if Years = 1 then
+ Days := Days + 365;
+
+ elsif Years = 2 then
+ Days := Days + 365 * 2;
+
+ elsif Years = 3 then
+ Days := Days + 365 * 3;
+ end if;
+
+ Days := Days + Cumulative_Days_Before_Month (Leap.Month);
+
+ if Is_Leap (Leap.Year)
+ and then Leap.Month > 2
+ then
+ Days := Days + 1;
+ end if;
+
+ -- Add the number of days since the start of VMS time till the
+ -- start of Ada time.
+
+ Days := Days + Leap.Day + VMS_Days;
+
+ -- Index - 1 previous leap seconds are added to Time (Index)
+
+ Leap_Second_Times (Index) :=
+ (Time (Days) * Secs_In_Day + Time (Index - 1)) * Mili;
+ end loop;
+ end;
end Ada.Calendar;
type Time is private;
- -- Declarations representing limits of allowed local time values. Note that
- -- these do NOT constrain the possible stored values of time which may well
- -- permit a larger range of times (this is explicitly allowed in Ada 95).
+ -- Declarations representing limits of allowed local time values. Note
+ -- that these do NOT constrain the possible stored values of time which
+ -- may well permit a larger range of times (this is explicitly allowed
+ -- in Ada 95).
- subtype Year_Number is Integer range 1901 .. 2099;
+ subtype Year_Number is Integer range 1901 .. 2399;
subtype Month_Number is Integer range 1 .. 12;
subtype Day_Number is Integer range 1 .. 31;
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
- Seconds : Day_Duration := 0.0)
- return Time;
+ Seconds : Day_Duration := 0.0) return Time;
function "+" (Left : Time; Right : Duration) return Time;
function "+" (Left : Duration; Right : Time) return Time;
Time_Error : exception;
- Unimplemented : exception;
-
private
-
pragma Inline (Clock);
pragma Inline (Year);
pragma Inline (">");
pragma Inline (">=");
- -- Time is represented as the number of 100-nanosecond (ns) units offset
- -- from the system base date and time, which is 00:00 o'clock,
- -- November 17, 1858 (the Smithsonian base date and time for the
- -- astronomic calendar).
+ -- Although the units are 100 nanoseconds, for the purpose of better
+ -- readability, this unit will be called "mili".
+
+ Mili : constant := 10_000_000;
+ Milis_In_Day : constant := 864_000_000_000;
+ Secs_In_Day : constant := 86_400;
+
+ -- Time is represented as the number of 100-nanosecond (ns) units from the
+ -- system base date and time 1858-11-17 0.0 (the Smithsonian base date and
+ -- time for the astronomic calendar).
-- The time value stored is typically a GMT value, as provided in standard
-- Unix environments. If this is the case then Split and Time_Of perform
-- required conversions to and from local times.
- type Time is new OSP.OS_Time;
-
-- Notwithstanding this definition, Time is not quite the same as OS_Time.
-- Relative Time is positive, whereas relative OS_Time is negative,
-- but this declaration makes for easier conversion.
- -- The following package provides handling of leap seconds. It is
- -- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both
- -- Ada 2005 children of Ada.Calendar.
-
- package Leap_Sec_Ops is
-
- After_Last_Leap : constant Time := Time'Last;
- -- Bigger by far than any leap second value. Not within range of
- -- Ada.Calendar specified dates.
-
- procedure Cumulative_Leap_Secs
- (Start_Date : Time;
- End_Date : Time;
- Leaps_Between : out Duration;
- Next_Leap_Sec : out Time);
- -- Leaps_Between is the sum of the leap seconds that have occured
- -- on or after Start_Date and before (strictly before) End_Date.
- -- Next_Leap_Sec represents the next leap second occurence on or
- -- after End_Date. If there are no leaps seconds after End_Date,
- -- After_Last_Leap is returned. This does not provide info about
- -- the next leap second (pos/neg or ?). After_Last_Leap can be used
- -- as End_Date to count all the leap seconds that have occured on
- -- or after Start_Date.
- --
- -- Important Notes: any fractional parts of Start_Date and End_Date
- -- are discarded before the calculations are done. For instance: if
- -- 113 seconds is a leap second (it isn't) and 113.5 is input as an
- -- End_Date, the leap second at 113 will not be counted in
- -- Leaps_Between, but it will be returned as Next_Leap_Sec. Thus, if
- -- the caller wants to know if the End_Date is a leap second, the
- -- comparison should be:
- --
- -- End_Date >= Next_Leap_Sec;
- --
- -- After_Last_Leap is designed so that this comparison works without
- -- having to first check if Next_Leap_Sec is a valid leap second.
-
- function All_Leap_Seconds return Duration;
- -- Returns the sum off all of the leap seoncds.
-
- end Leap_Sec_Ops;
-
- procedure Split_With_Offset
- (Date : Time;
- Year : out Year_Number;
- Month : out Month_Number;
- Day : out Day_Number;
- Seconds : out Day_Duration;
- Offset : out Long_Integer);
- -- Split_W_Offset has the same spec as Split with the addition of an
- -- offset value which give the offset of the local time zone from UTC
- -- at the input Date. This value comes for free during the implementation
- -- of Split and is needed by UTC_Time_Offset. The returned Offset time
- -- is straight from the C tm struct and is in seconds. If the system
- -- dependent code has no way to find the offset it will return the value
- -- Invalid_TZ_Offset declared below. Otherwise no checking is done, so
- -- it is up to the user to check both for Invalid_TZ_Offset and otherwise
- -- for a value that is acceptable.
-
- Invalid_TZ_Offset : Long_Integer;
- pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff");
+ type Time is new OSP.OS_Time;
+
+ -- The range of Ada time expressed as milis since the VMS Epoch
+
+ Ada_Low : constant Time := (10 * 366 + 32 * 365 + 45) * Milis_In_Day;
+ Ada_High : constant Time := (131 * 366 + 410 * 365 + 45) * Milis_In_Day;
+
+ Days_In_Month : constant array (Month_Number) of Day_Number :=
+ (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+
+ Invalid_Time_Zone_Offset : Long_Integer;
+ pragma Import (C, Invalid_Time_Zone_Offset, "__gnat_invalid_tzoff");
+
+ function Is_Leap (Year : Year_Number) return Boolean;
+ -- Determine whether a given year is leap
+
+ -- The following packages provide a target independent interface to the
+ -- children of Calendar - Arithmetic, Formatting and Time_Zones.
+
+ -- NOTE: Delays does not need a target independent interface because
+ -- VMS already has a target specific file for that package.
+
+ package Arithmetic_Operations is
+ function Add (Date : Time; Days : Long_Integer) return Time;
+ -- Add X number of days to a time value
+
+ procedure Difference
+ (Left : Time;
+ Right : Time;
+ Days : out Long_Integer;
+ Seconds : out Duration;
+ Leap_Seconds : out Integer);
+ -- Calculate the difference between two time values in terms of days,
+ -- seconds and leap seconds elapsed. The leap seconds are not included
+ -- in the seconds returned. If Left is greater than Right, the returned
+ -- values are positive, negative otherwise.
+
+ function Subtract (Date : Time; Days : Long_Integer) return Time;
+ -- Subtract X number of days from a time value
+ end Arithmetic_Operations;
+
+ package Formatting_Operations is
+ function Day_Of_Week (Date : Time) return Integer;
+ -- Determine which day of week Date falls on. The returned values are
+ -- within the range of 0 .. 6 (Monday .. Sunday).
+
+ procedure Split
+ (Date : Time;
+ Year : out Year_Number;
+ Month : out Month_Number;
+ Day : out Day_Number;
+ Day_Secs : out Day_Duration;
+ Hour : out Integer;
+ Minute : out Integer;
+ Second : out Integer;
+ Sub_Sec : out Duration;
+ Leap_Sec : out Boolean;
+ Time_Zone : Long_Integer);
+ -- Split a time value into its components
+
+ function Time_Of
+ (Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Day_Secs : Day_Duration;
+ Hour : Integer;
+ Minute : Integer;
+ Second : Integer;
+ Sub_Sec : Duration;
+ Leap_Sec : Boolean;
+ Leap_Checks : Boolean;
+ Use_Day_Secs : Boolean;
+ Time_Zone : Long_Integer) return Time;
+ -- Given all the components of a date, return the corresponding time
+ -- value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the
+ -- day duration will be calculated from Hour, Minute, Second and Sub_
+ -- Sec. Set flag Leap_Checks to verify the validity of a leap second.
+ end Formatting_Operations;
+
+ package Time_Zones_Operations is
+ function UTC_Time_Offset (Date : Time) return Long_Integer;
+ -- Return the offset in seconds from GMT
+ end Time_Zones_Operations;
end Ada.Calendar;
-- --
------------------------------------------------------------------------------
-with Unchecked_Conversion;
+with Ada.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;
- type long_Pointer is access all long;
- -- 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_tzoff
- (C : time_t_Pointer;
- res : tm_Pointer;
- off : long_Pointer);
- pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
- -- This is a lightweight wrapper around the system library localtime_r
- -- function. Parameter 'off' captures the UTC offset which is either
- -- retrieved from the tm struct or calculated from the 'timezone' extern
- -- and the tm_isdst flag in the tm struct.
-
- 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 a 56 year range that can be handled by Unix (1970 included -
- -- 2026 excluded). Dates that are not in this 56 year range are shifted
- -- by multiples of 56 years to fit in this range.
-
- -- 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. 56 has been chosen,
- -- because it is not only a multiple of 4, but also a multiple of 7. Thus
- -- two dates 56 years apart fall on the same day of the week, and the
- -- Daylight Saving Time change dates are usually the same for these two
- -- years.
-
- Unix_Year_Min : constant := 1970;
- Unix_Year_Max : constant := 2026;
-
- 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_56_Years : constant := Seconds_In_4_Years * 14;
- Seconds_In_56_YearsD : constant := Duration (Seconds_In_56_Years);
+ --------------------------
+ -- Implementation Notes --
+ --------------------------
+
+ -- In complex algorithms, some variables of type Ada.Calendar.Time carry
+ -- suffix _S or _N to denote units of seconds or nanoseconds.
+ --
+ -- Because time is measured in different units and from different origins
+ -- on various targets, a system independent model is incorporated into
+ -- Ada.Calendar. The idea behing the design is to encapsulate all target
+ -- dependent machinery in a single package, thus providing a uniform
+ -- interface to any existing and potential children.
+
+ -- package Ada.Calendar
+ -- procedure Split (5 parameters) -------+
+ -- | Call from local routine
+ -- private |
+ -- package Formatting_Operations |
+ -- procedure Split (11 parameters) <--+
+ -- end Formatting_Operations |
+ -- end Ada.Calendar |
+ -- |
+ -- package Ada.Calendar.Formatting | Call from child routine
+ -- procedure Split (9 or 10 parameters) -+
+ -- end Ada.Calendar.Formatting
+
+ -- The behaviour of the interfacing routines is controlled via various
+ -- flags. All new Ada 2005 types from children of Ada.Calendar are
+ -- emulated by a similar type. For instance, type Day_Number is replaced
+ -- by Integer in various routines. One ramification of this model is that
+ -- the caller site must perform validity checks on returned results.
+ -- The end result of this model is the lack of target specific files per
+ -- child of Ada.Calendar (a-calfor, a-calfor-vms, a-calfor-vxwors, etc).
+
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+
+ procedure Cumulative_Leap_Seconds
+ (Start_Date : Time;
+ End_Date : Time;
+ Elapsed_Leaps : out Natural;
+ Next_Leap_Sec : out Time);
+ -- Elapsed_Leaps is the sum of the leap seconds that have occured on or
+ -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
+ -- represents the next leap second occurence on or after End_Date. If
+ -- there are no leaps seconds after End_Date, After_Last_Leap is returned.
+ -- After_Last_Leap can be used as End_Date to count all the leap seconds
+ -- that have occured on or after Start_Date.
+ --
+ -- Note: Any sub seconds of Start_Date and End_Date are discarded before
+ -- the calculations are done. For instance: if 113 seconds is a leap
+ -- second (it isn't) and 113.5 is input as an End_Date, the leap second
+ -- at 113 will not be counted in Leaps_Between, but it will be returned
+ -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
+ -- a leap second, the comparison should be:
+ --
+ -- End_Date >= Next_Leap_Sec;
+ --
+ -- After_Last_Leap is designed so that this comparison works without
+ -- having to first check if Next_Leap_Sec is a valid leap second.
+
+ function To_Abs_Duration (T : Time) return Duration;
+ -- Convert a time value into a duration value. Note that the returned
+ -- duration is always positive.
+
+ function To_Abs_Time (D : Duration) return Time;
+ -- Return the time equivalent of a duration value. Since time cannot be
+ -- negative, the absolute value of D is used. It is upto the called to
+ -- decide how to handle negative durations converted into time.
+
+ ---------------------
+ -- Local Constants --
+ ---------------------
+
+ Ada_Min_Year : constant Year_Number := Year_Number'First;
+ After_Last_Leap : constant Time := Time'Last;
+ Leap_Seconds_Count : constant Natural := 23;
+ Secs_In_Four_Years : constant := (3 * 365 + 366) * Secs_In_Day;
+ Secs_In_Non_Leap_Year : constant := 365 * Secs_In_Day;
+ Time_Zero : constant Time := Time'First;
+
+ -- Even though the upper bound of Ada time is 2399-12-31 86_399.999999999
+ -- GMT, it must be shifted to include all leap seconds.
+
+ Ada_High_And_Leaps : constant Time :=
+ Ada_High + Time (Leap_Seconds_Count) * Nano;
+
+ Hard_Ada_High_And_Leaps : constant Time :=
+ Hard_Ada_High +
+ Time (Leap_Seconds_Count) * Nano;
+
+ -- The Unix lower time bound expressed as nanoseconds since the
+ -- start of Ada time in GMT.
+
+ Unix_Min : constant Time := (17 * 366 + 52 * 365) * Nanos_In_Day;
+
+ Cumulative_Days_Before_Month :
+ constant array (Month_Number) of Natural :=
+ (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
+
+ Leap_Second_Times : array (1 .. Leap_Seconds_Count) of Time;
+ -- Each value represents a time value which is one second before a leap
+ -- second occurence. This table is populated during the elaboration of
+ -- Ada.Calendar.
---------
-- "+" --
function "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
+
begin
- return (Left + Time (Right));
+ if Right = 0.0 then
+ return Left;
+
+ elsif Right < 0.0 then
+
+ -- Type Duration has one additional number in its negative subrange,
+ -- which is Duration'First. The subsequent invocation of "-" will
+ -- perform among other things an Unchecked_Conversion on that
+ -- particular value, causing overflow. If not properly handled,
+ -- the erroneous value will cause an infinite recursion between "+"
+ -- and "-". To properly handle this boundary case, we make a small
+ -- adjustment of one second to Duration'First.
+
+ if Right = Duration'First then
+ return Left - abs (Right + 1.0) - 1.0;
+ else
+ return Left - abs (Right);
+ end if;
+
+ else
+ declare
+ -- The input time value has been normalized to GMT
+
+ Result : constant Time := Left + To_Abs_Time (Right);
+
+ begin
+ -- The end result may excede the upper bound of Ada time. Note
+ -- that the comparison operator is ">=" rather than ">" since
+ -- the smallest increment of 0.000000001 to the legal end of
+ -- time (2399-12-31 86_399.999999999) will render the result
+ -- equal to Ada_High (2400-1-1 0.0).
+
+ if Result >= Ada_High_And_Leaps then
+ raise Time_Error;
+ end if;
+
+ return Result;
+ end;
+ end if;
+
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;
+ return Right + Left;
end "+";
---------
-- "-" --
---------
- function "-" (Left : Time; Right : Duration) return Time is
+ function "-" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
+
begin
- return Left - Time (Right);
+ if Right = 0.0 then
+ return Left;
+
+ elsif Right < 0.0 then
+ return Left + abs (Right);
+
+ else
+ declare
+ Result : Time;
+ Right_T : constant Time := To_Abs_Time (Right);
+
+ begin
+ -- Subtracting a larger time value from a smaller time value
+ -- will cause a wrap around since Time is a modular type. Note
+ -- that the time value has been normalized to GMT.
+
+ if Left < Right_T then
+ raise Time_Error;
+ end if;
+
+ Result := Left - Right_T;
+
+ if Result < Ada_Low
+ or else Result > Ada_High_And_Leaps
+ then
+ raise Time_Error;
+ end if;
+
+ return Result;
+ end;
+ end if;
+
exception
when Constraint_Error =>
raise Time_Error;
function "-" (Left : Time; Right : Time) return Duration is
pragma Unsuppress (Overflow_Check);
+
+ function To_Time is new Ada.Unchecked_Conversion (Duration, Time);
+
+ -- Since the absolute values of the upper and lower bound of duration
+ -- are denoted by the same number, it is sufficend to use Duration'Last
+ -- when performing out of range checks.
+
+ Duration_Bound : constant Time := To_Time (Duration'Last);
+
+ Earlier : Time;
+ Later : Time;
+ Negate : Boolean := False;
+ Result : Time;
+ Result_D : Duration;
+
begin
- return Duration (Left) - Duration (Right);
+ -- This routine becomes a little tricky since time cannot be negative,
+ -- but the subtraction of two time values can produce a negative value.
+
+ if Left > Right then
+ Later := Left;
+ Earlier := Right;
+ else
+ Later := Right;
+ Earlier := Left;
+ Negate := True;
+ end if;
+
+ Result := Later - Earlier;
+
+ -- Check whether the resulting difference is within the range of type
+ -- Duration. The following two conditions are examined with the same
+ -- piece of code:
+ --
+ -- positive result > positive upper bound of duration
+ --
+ -- negative (negative result) > abs (negative bound of duration)
+
+ if Result > Duration_Bound then
+ raise Time_Error;
+ end if;
+
+ Result_D := To_Abs_Duration (Result);
+
+ if Negate then
+ Result_D := -Result_D;
+ end if;
+
+ return Result_D;
exception
when Constraint_Error =>
raise Time_Error;
function "<" (Left, Right : Time) return Boolean is
begin
- return Duration (Left) < Duration (Right);
+ return Time_Rep (Left) < Time_Rep (Right);
end "<";
----------
function "<=" (Left, Right : Time) return Boolean is
begin
- return Duration (Left) <= Duration (Right);
+ return Time_Rep (Left) <= Time_Rep (Right);
end "<=";
---------
function ">" (Left, Right : Time) return Boolean is
begin
- return Duration (Left) > Duration (Right);
+ return Time_Rep (Left) > Time_Rep (Right);
end ">";
----------
function ">=" (Left, Right : Time) return Boolean is
begin
- return Duration (Left) >= Duration (Right);
+ return Time_Rep (Left) >= Time_Rep (Right);
end ">=";
-----------
-----------
function Clock return Time is
+ Elapsed_Leaps : Natural;
+ Next_Leap : Time;
+
+ -- The system clock returns the time in GMT since the Unix Epoch of
+ -- 1970-1-1 0.0. We perform an origin shift to the Ada Epoch by adding
+ -- the number of nanoseconds between the two origins.
+
+ Now : Time := To_Abs_Time (System.OS_Primitives.Clock) + Unix_Min;
+
+ Rounded_Now : constant Time := Now - (Now mod Nano);
+
begin
- return Time (System.OS_Primitives.Clock);
+ -- Determine how many leap seconds have elapsed until this moment
+
+ Cumulative_Leap_Seconds (Time_Zero, Now, Elapsed_Leaps, Next_Leap);
+
+ Now := Now + Time (Elapsed_Leaps) * Nano;
+
+ -- The system clock may fall exactly on a leap second occurence
+
+ if Rounded_Now = Next_Leap then
+ Now := Now + Time (1) * Nano;
+ end if;
+
+ -- Add the buffer set aside for time zone processing since Split in
+ -- Ada.Calendar.Formatting_Operations expects it to be there.
+
+ return Now + Buffer_N;
end Clock;
+ -----------------------------
+ -- Cumulative_Leap_Seconds --
+ -----------------------------
+
+ procedure Cumulative_Leap_Seconds
+ (Start_Date : Time;
+ End_Date : Time;
+ Elapsed_Leaps : out Natural;
+ Next_Leap_Sec : out Time)
+ is
+ End_Index : Positive;
+ End_T : Time := End_Date;
+ Start_Index : Positive;
+ Start_T : Time := Start_Date;
+
+ begin
+ -- Both input dates need to be normalized to GMT in order for this
+ -- routine to work properly.
+
+ pragma Assert (End_Date >= Start_Date);
+
+ Next_Leap_Sec := After_Last_Leap;
+
+ -- Make sure that the end date does not excede the upper bound
+ -- of Ada time.
+
+ if End_Date > Ada_High then
+ End_T := Ada_High;
+ end if;
+
+ -- Remove the sub seconds from both dates
+
+ Start_T := Start_T - (Start_T mod Nano);
+ End_T := End_T - (End_T mod Nano);
+
+ -- Some trivial cases:
+ -- Leap 1 . . . Leap N
+ -- ---+========+------+############+-------+========+-----
+ -- Start_T End_T Start_T End_T
+
+ if End_T < Leap_Second_Times (1) then
+ Elapsed_Leaps := 0;
+ Next_Leap_Sec := Leap_Second_Times (1);
+ return;
+
+ elsif Start_T > Leap_Second_Times (Leap_Seconds_Count) then
+ Elapsed_Leaps := 0;
+ Next_Leap_Sec := After_Last_Leap;
+ return;
+ end if;
+
+ -- Perform the calculations only if the start date is within the leap
+ -- second occurences table.
+
+ if Start_T <= Leap_Second_Times (Leap_Seconds_Count) then
+
+ -- 1 2 N - 1 N
+ -- +----+----+-- . . . --+-------+---+
+ -- | T1 | T2 | | N - 1 | N |
+ -- +----+----+-- . . . --+-------+---+
+ -- ^ ^
+ -- | Start_Index | End_Index
+ -- +-------------------+
+ -- Leaps_Between
+
+ -- The idea behind the algorithm is to iterate and find two
+ -- closest dates which are after Start_T and End_T. Their
+ -- corresponding index difference denotes the number of leap
+ -- seconds elapsed.
+
+ Start_Index := 1;
+ loop
+ exit when Leap_Second_Times (Start_Index) >= Start_T;
+ Start_Index := Start_Index + 1;
+ end loop;
+
+ End_Index := Start_Index;
+ loop
+ exit when End_Index > Leap_Seconds_Count
+ or else Leap_Second_Times (End_Index) >= End_T;
+ End_Index := End_Index + 1;
+ end loop;
+
+ if End_Index <= Leap_Seconds_Count then
+ Next_Leap_Sec := Leap_Second_Times (End_Index);
+ end if;
+
+ Elapsed_Leaps := End_Index - Start_Index;
+
+ else
+ Elapsed_Leaps := 0;
+ end if;
+ end Cumulative_Leap_Seconds;
+
---------
-- Day --
---------
function Day (Date : Time) return Day_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DD;
+ Split (Date, Y, M, D, S);
+ return D;
end Day;
+ -------------
+ -- Is_Leap --
+ -------------
+
+ function Is_Leap (Year : Year_Number) return Boolean is
+ begin
+ -- Leap centenial years
+
+ if Year mod 400 = 0 then
+ return True;
+
+ -- Non-leap centenial years
+
+ elsif Year mod 100 = 0 then
+ return False;
+
+ -- Regular years
+
+ else
+ return Year mod 4 = 0;
+ end if;
+ end Is_Leap;
+
-----------
-- Month --
-----------
function Month (Date : Time) return Month_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DM;
+ Split (Date, Y, M, D, S);
+ return M;
end Month;
-------------
-------------
function Seconds (Date : Time) return Day_Duration is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DS;
+ Split (Date, Y, M, D, S);
+ return S;
end Seconds;
-----------
Day : out Day_Number;
Seconds : out Day_Duration)
is
- Offset : Long_Integer;
+ H : Integer;
+ M : Integer;
+ Se : Integer;
+ Ss : Duration;
+ Le : Boolean;
+ Tz : constant Long_Integer :=
+ Time_Zones_Operations.UTC_Time_Offset (Date) / 60;
begin
- Split_With_Offset (Date, Year, Month, Day, Seconds, Offset);
- end Split;
+ Formatting_Operations.Split
+ (Date, Year, Month, Day, Seconds, H, M, Se, Ss, Le, Tz);
- -----------------------
- -- Split_With_Offset --
- -----------------------
+ -- Validity checks
- procedure Split_With_Offset
- (Date : Time;
- Year : out Year_Number;
- Month : out Month_Number;
- Day : out Day_Number;
- Seconds : out Day_Duration;
- Offset : out Long_Integer)
- 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.
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else not Seconds'Valid
+ then
+ raise Time_Error;
+ end if;
+ end Split;
- Low : constant := (Ada_Year_Min - Unix_Year_Min - 2) * 365 * 86_400;
- High : constant := (Ada_Year_Max - Unix_Year_Min + 2) * 365 * 86_400;
+ -------------
+ -- Time_Of --
+ -------------
- LowD : constant Duration := Duration (Low);
- HighD : constant Duration := Duration (High);
+ function Time_Of
+ (Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Seconds : Day_Duration := 0.0) return Time
+ is
+ -- The values in the following constants are irrelevant, they are just
+ -- placeholders; the choice of constructing a Day_Duration value is
+ -- controlled by the Use_Day_Secs flag.
- -- Finally the actual variables used in the computation
+ H : constant Integer := 1;
+ M : constant Integer := 1;
+ Se : constant Integer := 1;
+ Ss : constant Duration := 0.1;
- Adjusted_Seconds : aliased time_t;
- D : Duration;
- Frac_Sec : Duration;
- Local_Offset : aliased long;
- Tm_Val : aliased tm;
- Year_Val : Integer;
+ Mid_Offset : Long_Integer;
+ Mid_Result : Time;
+ Offset : Long_Integer;
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
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else not Seconds'Valid
+ 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.
+ -- Building a time value in a local time zone is tricky since the
+ -- local time zone offset at the point of creation may not be the
+ -- same as the actual time zone offset designated by the input
+ -- values. The following example is relevant to New York, USA.
+ --
+ -- Creation date: 2006-10-10 0.0 Offset -240 mins (in DST)
+ -- Actual date : 1901-01-01 0.0 Offset -300 mins (no DST)
- -- If we have a value outside this range, then we first adjust it to be
- -- in the required range by adding multiples of 56 years. For the range
- -- we are interested in, the number of days in any consecutive 56 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_56_YearsD;
- Year_Val := Year_Val - 56;
- end loop;
+ -- We first start by obtaining the current local time zone offset
+ -- using Ada.Calendar.Clock, then building an intermediate time
+ -- value using that offset.
- while D >= Seconds_In_56_YearsD loop
- D := D - Seconds_In_56_YearsD;
- Year_Val := Year_Val + 56;
- end loop;
+ Mid_Offset := Time_Zones_Operations.UTC_Time_Offset (Clock) / 60;
+ Mid_Result := Formatting_Operations.Time_Of
+ (Year, Month, Day, Seconds, H, M, Se, Ss,
+ Leap_Sec => False,
+ Leap_Checks => False,
+ Use_Day_Secs => True,
+ Time_Zone => Mid_Offset);
- -- 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).
+ -- This is the true local time zone offset of the input time values
- -- 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
+ Offset := Time_Zones_Operations.UTC_Time_Offset (Mid_Result) / 60;
- declare
- type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
- for D_Int'Size use Duration'Size;
+ -- It is possible that at the point of invocation of Time_Of, both
+ -- the current local time zone offset and the one designated by the
+ -- input values are in the same DST mode.
- function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
- function To_Duration is new Unchecked_Conversion (D_Int, Duration);
+ if Offset = Mid_Offset then
+ return Mid_Result;
- D_As_Int : constant D_Int := To_D_Int (D);
- Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
+ -- In this case we must calculate the new time with the new offset. It
+ -- is no sufficient to just take the relative difference between the
+ -- two offsets and adjust the intermediate result, because this does not
+ -- work around leap second times.
- begin
- Adjusted_Seconds := time_t (D_As_Int / Small_Div);
- Frac_Sec := To_Duration (D_As_Int rem Small_Div);
- end;
-
- localtime_tzoff
- (Adjusted_Seconds'Unchecked_Access,
- Tm_Val'Unchecked_Access,
- Local_Offset'Unchecked_Access);
-
- Year_Val := Tm_Val.tm_year + 1900 + Year_Val;
- Month := Tm_Val.tm_mon + 1;
- Day := Tm_Val.tm_mday;
- Offset := Long_Integer (Local_Offset);
-
- -- 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;
+ declare
+ Result : constant Time :=
+ Formatting_Operations.Time_Of
+ (Year, Month, Day, Seconds, H, M, Se, Ss,
+ Leap_Sec => False,
+ Leap_Checks => False,
+ Use_Day_Secs => True,
+ Time_Zone => Offset);
+
+ begin
+ return Result;
+ end;
end if;
- end Split_With_Offset;
-
- -------------
- -- Time_Of --
- -------------
+ end 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);
+ ---------------------
+ -- To_Abs_Duration --
+ ---------------------
- Year_Val : Integer := Year;
- Duration_Adjust : Duration := 0.0;
+ function To_Abs_Duration (T : Time) return Duration is
+ pragma Unsuppress (Overflow_Check);
+ function To_Duration is new Ada.Unchecked_Conversion (Time, Duration);
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;
+ return To_Duration (T);
- -- Check for Day value too large (one might expect mktime to do this
- -- check, as well as the basic 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
+ exception
+ when Constraint_Error =>
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 56 year steps, since the number of days in 56 years is
- -- constant, so the timezone effect on the conversion from local time
- -- to GMT is unaffected; also the DST change dates are usually not
- -- modified.
-
- while Year_Val < Unix_Year_Min loop
- Year_Val := Year_Val + 56;
- Duration_Adjust := Duration_Adjust - Seconds_In_56_YearsD;
- end loop;
+ end To_Abs_Duration;
- while Year_Val >= Unix_Year_Max loop
- Year_Val := Year_Val - 56;
- Duration_Adjust := Duration_Adjust + Seconds_In_56_YearsD;
- end loop;
+ -----------------
+ -- To_Abs_Time --
+ -----------------
- TM_Val.tm_year := Year_Val - 1900;
+ function To_Abs_Time (D : Duration) return Time is
+ pragma Unsuppress (Overflow_Check);
+ function To_Time is new Ada.Unchecked_Conversion (Duration, Time);
- -- If time is very close to UNIX epoch mktime may behave uncorrectly
- -- because of the way the different time zones are handled (a date
- -- after epoch in a given time zone may correspond to a GMT date
- -- before epoch). Adding one day to the date (this amount is latter
- -- substracted) avoids this problem.
+ begin
+ -- This operation assumes that D is positive
- if Year_Val = Unix_Year_Min
- and then Month = 1
- and then Day = 1
- then
- TM_Val.tm_mday := TM_Val.tm_mday + 1;
- Duration_Adjust := Duration_Adjust - Duration (86400.0);
+ if D < 0.0 then
+ raise Constraint_Error;
end if;
- -- Since we do not have information on daylight savings, rely on the
- -- default information.
+ return To_Time (D);
- 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;
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end To_Abs_Time;
----------
-- Year --
----------
function Year (Date : Time) return Year_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
+ Y : Year_Number;
+ M : Month_Number;
+ D : Day_Number;
+ S : Day_Duration;
begin
- Split (Date, DY, DM, DD, DS);
- return DY;
+ Split (Date, Y, M, D, S);
+ return Y;
end Year;
- -------------------
- -- Leap_Sec_Ops --
- -------------------
+ -- The following packages assume that Time is a modular 64 bit integer
+ -- type, the units are nanoseconds and the origin is the start of Ada
+ -- time (1901-1-1 0.0).
- -- The package that is used by the Ada 2005 children of Ada.Calendar:
- -- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
+ ---------------------------
+ -- Arithmetic_Operations --
+ ---------------------------
- package body Leap_Sec_Ops is
+ package body Arithmetic_Operations is
- -- This package must be updated when leap seconds are added. Adding a
- -- leap second requires incrementing the value of N_Leap_Secs and adding
- -- the day of the new leap second to the end of Leap_Second_Dates.
+ ---------
+ -- Add --
+ ---------
- -- Elaboration of the Leap_Sec_Ops package takes care of converting the
- -- Leap_Second_Dates table to a form that is better suited for the
- -- procedures provided by this package (a table that would be more
- -- difficult to maintain by hand).
+ function Add (Date : Time; Days : Long_Integer) return Time is
+ begin
+ if Days = 0 then
+ return Date;
- N_Leap_Secs : constant := 23;
+ elsif Days < 0 then
+ return Subtract (Date, abs (Days));
- type Leap_Second_Date is record
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- end record;
+ else
+ declare
+ Result : constant Time := Date + Time (Days) * Nanos_In_Day;
- Leap_Second_Dates :
- constant array (1 .. N_Leap_Secs) of Leap_Second_Date :=
- ((1972, 6, 30), (1972, 12, 31), (1973, 12, 31), (1974, 12, 31),
- (1975, 12, 31), (1976, 12, 31), (1977, 12, 31), (1978, 12, 31),
- (1979, 12, 31), (1981, 6, 30), (1982, 6, 30), (1983, 6, 30),
- (1985, 6, 30), (1987, 12, 31), (1989, 12, 31), (1990, 12, 31),
- (1992, 6, 30), (1993, 6, 30), (1994, 6, 30), (1995, 12, 31),
- (1997, 6, 30), (1998, 12, 31), (2005, 12, 31));
+ begin
+ -- The result excedes the upper bound of Ada time
- Leap_Second_Times : array (1 .. N_Leap_Secs) of Time;
- -- This is the needed internal representation that is calculated
- -- from Leap_Second_Dates during elaboration;
+ if Result > Ada_High_And_Leaps then
+ raise Time_Error;
+ end if;
- --------------------------
- -- Cumulative_Leap_Secs --
- --------------------------
+ return Result;
+ end;
+ end if;
- procedure Cumulative_Leap_Secs
- (Start_Date : Time;
- End_Date : Time;
- Leaps_Between : out Duration;
- Next_Leap_Sec : out Time)
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end Add;
+
+ ----------------
+ -- Difference --
+ ----------------
+
+ procedure Difference
+ (Left : Time;
+ Right : Time;
+ Days : out Long_Integer;
+ Seconds : out Duration;
+ Leap_Seconds : out Integer)
is
- End_T : Time;
- K : Positive;
- Leap_Index : Positive;
- Start_Tmp : Time;
- Start_T : Time;
+ Diff_N : Time;
+ Diff_S : Time;
+ Earlier : Time;
+ Elapsed_Leaps : Natural;
+ Later : Time;
+ Negate : Boolean := False;
+ Next_Leap : Time;
+ Sub_Seconds : Duration;
- 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;
+ begin
+ -- Both input time values are assumed to be in GMT
- function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
+ if Left >= Right then
+ Later := Left;
+ Earlier := Right;
+ else
+ Later := Right;
+ Earlier := Left;
+ Negate := True;
+ end if;
- begin
- Next_Leap_Sec := After_Last_Leap;
+ -- First process the leap seconds
- -- We want to throw away the fractional part of seconds. Before
- -- proceding with this operation, make sure our working values
- -- are non-negative.
+ Cumulative_Leap_Seconds (Earlier, Later, Elapsed_Leaps, Next_Leap);
- if End_Date < 0.0 then
- Leaps_Between := 0.0;
- return;
+ if Later >= Next_Leap then
+ Elapsed_Leaps := Elapsed_Leaps + 1;
end if;
- if Start_Date < 0.0 then
- Start_Tmp := Time (0.0);
- else
- Start_Tmp := Start_Date;
+ Diff_N := Later - Earlier - Time (Elapsed_Leaps) * Nano;
+
+ -- Sub second processing
+
+ Sub_Seconds := Duration (Diff_N mod Nano) / Nano_F;
+
+ -- Convert to seconds. Note that his action eliminates the sub
+ -- seconds automatically.
+
+ Diff_S := Diff_N / Nano;
+
+ Days := Long_Integer (Diff_S / Secs_In_Day);
+ Seconds := Duration (Diff_S mod Secs_In_Day) + Sub_Seconds;
+ Leap_Seconds := Integer (Elapsed_Leaps);
+
+ if Negate then
+ Days := -Days;
+ Seconds := -Seconds;
+ Leap_Seconds := -Leap_Seconds;
end if;
+ end Difference;
- if Start_Date <= Leap_Second_Times (N_Leap_Secs) then
-
- -- Manipulate the fixed point value as an integer, similar to
- -- Ada.Calendar.Split in order to remove the fractional part
- -- from the time we will work with, Start_T and End_T.
-
- D_As_Int := To_D_As_Int (Duration (Start_Tmp));
- D_As_Int := D_As_Int / Small_Div;
- Start_T := Time (D_As_Int);
- D_As_Int := To_D_As_Int (Duration (End_Date));
- D_As_Int := D_As_Int / Small_Div;
- End_T := Time (D_As_Int);
-
- Leap_Index := 1;
- loop
- exit when Leap_Second_Times (Leap_Index) >= Start_T;
- Leap_Index := Leap_Index + 1;
- end loop;
-
- K := Leap_Index;
- loop
- exit when K > N_Leap_Secs or else
- Leap_Second_Times (K) >= End_T;
- K := K + 1;
- end loop;
-
- if K <= N_Leap_Secs then
- Next_Leap_Sec := Leap_Second_Times (K);
- end if;
+ --------------
+ -- Subtract --
+ --------------
+
+ function Subtract (Date : Time; Days : Long_Integer) return Time is
+ begin
+ if Days = 0 then
+ return Date;
+
+ elsif Days < 0 then
+ return Add (Date, abs (Days));
- Leaps_Between := Duration (K - Leap_Index);
else
- Leaps_Between := Duration (0.0);
+ declare
+ Days_T : constant Time := Time (Days) * Nanos_In_Day;
+ Result : Time;
+
+ begin
+ -- Subtracting a larger number of days from a smaller time
+ -- value will cause wrap around since time is a modular type.
+
+ if Date < Days_T then
+ raise Time_Error;
+ end if;
+
+ Result := Date - Days_T;
+
+ if Result < Ada_Low
+ or else Result > Ada_High_And_Leaps
+ then
+ raise Time_Error;
+ end if;
+
+ return Result;
+ end;
end if;
- end Cumulative_Leap_Secs;
- ----------------------
- -- All_Leap_Seconds --
- ----------------------
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end Subtract;
+ end Arithmetic_Operations;
+
+ ----------------------
+ -- Delay_Operations --
+ ----------------------
+
+ package body Delays_Operations is
+
+ -----------------
+ -- To_Duration --
+ -----------------
+
+ function To_Duration (Ada_Time : Time) return Duration is
+ Elapsed_Leaps : Natural;
+ Modified_Time : Time;
+ Next_Leap : Time;
+ Result : Duration;
+ Rounded_Time : Time;
- function All_Leap_Seconds return Duration is
begin
- return Duration (N_Leap_Secs);
- -- Presumes each leap second is +1.0 second;
- end All_Leap_Seconds;
+ Modified_Time := Ada_Time;
+ Rounded_Time := Modified_Time - (Modified_Time mod Nano);
- -- Start of processing in package Leap_Sec_Ops
+ -- Remove all leap seconds
+
+ Cumulative_Leap_Seconds
+ (Time_Zero, Modified_Time, Elapsed_Leaps, Next_Leap);
+
+ Modified_Time := Modified_Time - Time (Elapsed_Leaps) * Nano;
+
+ -- The input time value may fall on a leap second occurence
+
+ if Rounded_Time = Next_Leap then
+ Modified_Time := Modified_Time - Time (1) * Nano;
+ end if;
+
+ -- Perform a shift in origins
+
+ Result := Modified_Time - Unix_Min;
+
+ -- Remove the buffer period used in time zone processing
+
+ return Result - Buffer_D;
+ end To_Duration;
+ end Delays_Operations;
+
+ ---------------------------
+ -- Formatting_Operations --
+ ---------------------------
+
+ package body Formatting_Operations is
+
+ -----------------
+ -- Day_Of_Week --
+ -----------------
+
+ function Day_Of_Week (Date : Time) return Integer is
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ Dd : Day_Duration;
+ H : Integer;
+ Mi : Integer;
+ Se : Integer;
+ Su : Duration;
+ Le : Boolean;
+
+ Day_Count : Long_Integer;
+ Midday_Date_S : Time;
+
+ begin
+ Formatting_Operations.Split
+ (Date, Y, Mo, D, Dd, H, Mi, Se, Su, Le, 0);
+
+ -- Build a time value in the middle of the same day, remove the
+ -- lower buffer and convert the time value to seconds.
+
+ Midday_Date_S := (Formatting_Operations.Time_Of
+ (Y, Mo, D, 0.0, 12, 0, 0, 0.0,
+ Leap_Sec => False,
+ Leap_Checks => False,
+ Use_Day_Secs => False,
+ Time_Zone => 0) - Buffer_N) / Nano;
+
+ -- Count the number of days since the start of Ada time. 1901-1-1
+ -- GMT was a Tuesday.
+
+ Day_Count := Long_Integer (Midday_Date_S / Secs_In_Day) + 1;
+
+ return Integer (Day_Count mod 7);
+ end Day_Of_Week;
+
+ -----------
+ -- Split --
+ -----------
+
+ procedure Split
+ (Date : Time;
+ Year : out Year_Number;
+ Month : out Month_Number;
+ Day : out Day_Number;
+ Day_Secs : out Day_Duration;
+ Hour : out Integer;
+ Minute : out Integer;
+ Second : out Integer;
+ Sub_Sec : out Duration;
+ Leap_Sec : out Boolean;
+ Time_Zone : Long_Integer)
+ is
+ -- The following constants represent the number of nanoseconds
+ -- elapsed since the start of Ada time to and including the non
+ -- leap centenial years.
+
+ Year_2101 : constant Time := (49 * 366 + 151 * 365) * Nanos_In_Day;
+ Year_2201 : constant Time := (73 * 366 + 227 * 365) * Nanos_In_Day;
+ Year_2301 : constant Time := (97 * 366 + 303 * 365) * Nanos_In_Day;
+
+ Abs_Time_Zone : Time;
+ Day_Seconds : Natural;
+ Elapsed_Leaps : Natural;
+ Four_Year_Segs : Natural;
+ Hour_Seconds : Natural;
+ Is_Leap_Year : Boolean;
+ Modified_Date_N : Time;
+ Modified_Date_S : Time;
+ Next_Leap_N : Time;
+ Rem_Years : Natural;
+ Rounded_Date_N : Time;
+ Year_Day : Natural;
- begin
- declare
- Days : Natural;
- Is_Leap_Year : Boolean;
- Years : Natural;
-
- Cumulative_Days_Before_Month :
- constant array (Month_Number) of Natural :=
- (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
begin
- for J in 1 .. N_Leap_Secs loop
- Years := Leap_Second_Dates (J).Year - Unix_Year_Min;
- Days := (Years / 4) * Days_In_4_Years;
- Years := Years mod 4;
- Is_Leap_Year := False;
+ Modified_Date_N := Date;
+
+ if Modified_Date_N < Hard_Ada_Low
+ or else Modified_Date_N > Hard_Ada_High_And_Leaps
+ then
+ raise Time_Error;
+ end if;
- if Years = 1 then
- Days := Days + 365;
+ -- Step 1: Leap seconds processing in GMT
+
+ -- Day_Duration: 86_398 86_399 X (86_400) 0 (1) 1 (2)
+ -- Time : --+-------+-------+----------+------+-->
+ -- Seconds : 58 59 60 (Leap) 1 2
+
+ -- o Modified_Date_N falls between 86_399 and X (86_400)
+ -- Elapsed_Leaps = X - 1 leaps
+ -- Rounded_Date_N = 86_399
+ -- Next_Leap_N = X (86_400)
+ -- Leap_Sec = False
+
+ -- o Modified_Date_N falls exactly on X (86_400)
+ -- Elapsed_Leaps = X - 1 leaps
+ -- Rounded_Date_N = X (86_400)
+ -- Next_Leap_N = X (86_400)
+ -- Leap_Sec = True
+ -- An invisible leap second will be added.
+
+ -- o Modified_Date_N falls between X (86_400) and 0 (1)
+ -- Elapsed_Leaps = X - 1 leaps
+ -- Rounded_Date_N = X (86_400)
+ -- Next_Leap_N = X (86_400)
+ -- Leap_Sec = True
+ -- An invisible leap second will be added.
+
+ -- o Modified_Date_N falls on 0 (1)
+ -- Elapsed_Leaps = X
+ -- Rounded_Date_N = 0 (1)
+ -- Next_Leap_N = X + 1
+ -- Leap_Sec = False
+ -- The invisible leap second has already been accounted for in
+ -- Elapsed_Leaps.
+
+ Cumulative_Leap_Seconds
+ (Time_Zero, Modified_Date_N, Elapsed_Leaps, Next_Leap_N);
+
+ Rounded_Date_N := Modified_Date_N - (Modified_Date_N mod Nano);
+ Leap_Sec := Rounded_Date_N = Next_Leap_N;
+ Modified_Date_N := Modified_Date_N - Time (Elapsed_Leaps) * Nano;
+
+ if Leap_Sec then
+ Modified_Date_N := Modified_Date_N - Time (1) * Nano;
+ end if;
- elsif Years = 2 then
- Is_Leap_Year := True;
+ -- Step 2: Time zone processing. This action converts the input date
+ -- from GMT to the requested time zone.
- -- 1972 or multiple of 4 after
+ if Time_Zone /= 0 then
+ Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Nano;
- Days := Days + 365 * 2;
+ if Time_Zone < 0 then
+ -- The following test is obsolete since the date already
+ -- contains the dedicated buffer for time zones, thus no
+ -- error will be raised. However it is a good idea to keep
+ -- it should the representation of time change.
- elsif Years = 3 then
- Days := Days + 365 * 3 + 1;
+ Modified_Date_N := Modified_Date_N - Abs_Time_Zone;
+ else
+ Modified_Date_N := Modified_Date_N + Abs_Time_Zone;
end if;
+ end if;
+
+ -- After the elapsed leap seconds have been removed and the date
+ -- has been normalized, it should fall withing the soft bounds of
+ -- Ada time.
+
+ if Modified_Date_N < Ada_Low
+ or else Modified_Date_N > Ada_High
+ then
+ raise Time_Error;
+ end if;
+
+ -- Before any additional arithmetic is performed we must remove the
+ -- lower buffer period since it will be accounted as few additional
+ -- days.
- Days := Days + Cumulative_Days_Before_Month
- (Leap_Second_Dates (J).Month);
+ Modified_Date_N := Modified_Date_N - Buffer_N;
+
+ -- Step 3: Non-leap centenial year adjustment in local time zone
+
+ -- In order for all divisions to work properly and to avoid more
+ -- complicated arithmetic, we add fake Febriary 29s to dates which
+ -- occur after a non-leap centenial year.
+
+ if Modified_Date_N >= Year_2301 then
+ Modified_Date_N := Modified_Date_N + Time (3) * Nanos_In_Day;
+
+ elsif Modified_Date_N >= Year_2201 then
+ Modified_Date_N := Modified_Date_N + Time (2) * Nanos_In_Day;
+
+ elsif Modified_Date_N >= Year_2101 then
+ Modified_Date_N := Modified_Date_N + Time (1) * Nanos_In_Day;
+ end if;
- if Is_Leap_Year
- and then Leap_Second_Dates (J).Month > 2
+ -- Step 4: Sub second processing in local time zone
+
+ Sub_Sec := Duration (Modified_Date_N mod Nano) / Nano_F;
+
+ -- Convert the date into seconds, the sub seconds are automatically
+ -- dropped.
+
+ Modified_Date_S := Modified_Date_N / Nano;
+
+ -- Step 5: Year processing in local time zone. Determine the number
+ -- of four year segments since the start of Ada time and the input
+ -- date.
+
+ Four_Year_Segs := Natural (Modified_Date_S / Secs_In_Four_Years);
+
+ if Four_Year_Segs > 0 then
+ Modified_Date_S := Modified_Date_S - Time (Four_Year_Segs) *
+ Secs_In_Four_Years;
+ end if;
+
+ -- Calculate the remaining non-leap years
+
+ Rem_Years := Natural (Modified_Date_S / Secs_In_Non_Leap_Year);
+
+ if Rem_Years > 3 then
+ Rem_Years := 3;
+ end if;
+
+ Modified_Date_S := Modified_Date_S - Time (Rem_Years) *
+ Secs_In_Non_Leap_Year;
+
+ Year := Ada_Min_Year + Natural (4 * Four_Year_Segs + Rem_Years);
+ Is_Leap_Year := Is_Leap (Year);
+
+ -- Step 6: Month and day processing in local time zone
+
+ Year_Day := Natural (Modified_Date_S / Secs_In_Day) + 1;
+
+ Month := 1;
+
+ -- Processing for months after January
+
+ if Year_Day > 31 then
+ Month := 2;
+ Year_Day := Year_Day - 31;
+
+ -- Processing for a new month or a leap February
+
+ if Year_Day > 28
+ and then (not Is_Leap_Year
+ or else Year_Day > 29)
then
- Days := Days + 1;
+ Month := 3;
+ Year_Day := Year_Day - 28;
+
+ if Is_Leap_Year then
+ Year_Day := Year_Day - 1;
+ end if;
+
+ -- Remaining months
+
+ while Year_Day > Days_In_Month (Month) loop
+ Year_Day := Year_Day - Days_In_Month (Month);
+ Month := Month + 1;
+ end loop;
end if;
+ end if;
- Days := Days + Leap_Second_Dates (J).Day;
+ -- Step 7: Hour, minute, second and sub second processing in local
+ -- time zone.
+
+ Day := Day_Number (Year_Day);
+ Day_Seconds := Integer (Modified_Date_S mod Secs_In_Day);
+ Day_Secs := Duration (Day_Seconds) + Sub_Sec;
+ Hour := Day_Seconds / 3_600;
+ Hour_Seconds := Day_Seconds mod 3_600;
+ Minute := Hour_Seconds / 60;
+ Second := Hour_Seconds mod 60;
+ end Split;
+
+ -------------
+ -- Time_Of --
+ -------------
+
+ function Time_Of
+ (Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Day_Secs : Day_Duration;
+ Hour : Integer;
+ Minute : Integer;
+ Second : Integer;
+ Sub_Sec : Duration;
+ Leap_Sec : Boolean;
+ Leap_Checks : Boolean;
+ Use_Day_Secs : Boolean;
+ Time_Zone : Long_Integer) return Time
+ is
+ Abs_Time_Zone : Time;
+ Count : Integer;
+ Elapsed_Leaps : Natural;
+ Next_Leap_N : Time;
+ Result_N : Time;
+ Rounded_Result_N : Time;
+
+ begin
+ -- Step 1: Check whether the day, month and year form a valid date
+
+ if Day > Days_In_Month (Month)
+ and then (Day /= 29 or else Month /= 2 or else not Is_Leap (Year))
+ then
+ raise Time_Error;
+ end if;
+
+ -- Start accumulating nanoseconds from the low bound of Ada time.
+ -- Note: This starting point includes the lower buffer dedicated
+ -- to time zones.
+
+ Result_N := Ada_Low;
+
+ -- Step 2: Year processing and centenial year adjustment. Determine
+ -- the number of four year segments since the start of Ada time and
+ -- the input date.
+
+ Count := (Year - Year_Number'First) / 4;
+ Result_N := Result_N + Time (Count) * Secs_In_Four_Years * Nano;
+
+ -- Note that non-leap centenial years are automatically considered
+ -- leap in the operation above. An adjustment of several days is
+ -- required to compensate for this.
+
+ if Year > 2300 then
+ Result_N := Result_N - Time (3) * Nanos_In_Day;
+
+ elsif Year > 2200 then
+ Result_N := Result_N - Time (2) * Nanos_In_Day;
- Leap_Second_Times (J) :=
- Time (Days * Duration (86_400.0) + Duration (J - 1));
+ elsif Year > 2100 then
+ Result_N := Result_N - Time (1) * Nanos_In_Day;
+ end if;
+
+ -- Add the remaining non-leap years
+
+ Count := (Year - Year_Number'First) mod 4;
+ Result_N := Result_N + Time (Count) * Secs_In_Non_Leap_Year * Nano;
+
+ -- Step 3: Day of month processing. Determine the number of days
+ -- since the start of the current year. Do not add the current
+ -- day since it has not elapsed yet.
+
+ Count := Cumulative_Days_Before_Month (Month) + Day - 1;
+
+ -- The input year is leap and we have passed February
- -- Add one to get to the leap second. Add J - 1 previous
- -- leap seconds.
+ if Is_Leap (Year)
+ and then Month > 2
+ then
+ Count := Count + 1;
+ end if;
+
+ Result_N := Result_N + Time (Count) * Nanos_In_Day;
+
+ -- Step 4: Hour, minute, second and sub second processing
+
+ if Use_Day_Secs then
+ Result_N := Result_N + To_Abs_Time (Day_Secs);
+
+ else
+ Result_N := Result_N +
+ Time (Hour * 3_600 + Minute * 60 + Second) * Nano;
+ if Sub_Sec = 1.0 then
+ Result_N := Result_N + Time (1) * Nano;
+ else
+ Result_N := Result_N + To_Abs_Time (Sub_Sec);
+ end if;
+ end if;
+
+ -- Step 4: Time zone processing. At this point we have built an
+ -- arbitrary time value which is not related to any time zone.
+ -- For simplicity, the time value is normalized to GMT, producing
+ -- a uniform representation which can be treated by arithmetic
+ -- operations for instance without any additional corrections.
+
+ if Result_N < Ada_Low
+ or else Result_N > Ada_High
+ then
+ raise Time_Error;
+ end if;
+
+ if Time_Zone /= 0 then
+ Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Nano;
+
+ if Time_Zone < 0 then
+ Result_N := Result_N + Abs_Time_Zone;
+ else
+ -- The following test is obsolete since the result already
+ -- contains the dedicated buffer for time zones, thus no
+ -- error will be raised. However it is a good idea to keep
+ -- this comparison should the representation of time change.
+
+ if Result_N < Abs_Time_Zone then
+ raise Time_Error;
+ end if;
+
+ Result_N := Result_N - Abs_Time_Zone;
+ end if;
+ end if;
+
+ -- Step 5: Leap seconds processing in GMT
+
+ Cumulative_Leap_Seconds
+ (Time_Zero, Result_N, Elapsed_Leaps, Next_Leap_N);
+
+ Result_N := Result_N + Time (Elapsed_Leaps) * Nano;
+
+ -- An Ada 2005 caller requesting an explicit leap second or an Ada
+ -- 95 caller accounting for an invisible leap second.
+
+ Rounded_Result_N := Result_N - (Result_N mod Nano);
+
+ if Leap_Sec
+ or else Rounded_Result_N = Next_Leap_N
+ then
+ Result_N := Result_N + Time (1) * Nano;
+ Rounded_Result_N := Rounded_Result_N + Time (1) * Nano;
+ end if;
+
+ -- Leap second validity check
+
+ if Leap_Checks
+ and then Leap_Sec
+ and then Rounded_Result_N /= Next_Leap_N
+ then
+ raise Time_Error;
+ end if;
+
+ -- Final bounds check
+
+ if Result_N < Hard_Ada_Low
+ or else Result_N > Hard_Ada_High_And_Leaps
+ then
+ raise Time_Error;
+ end if;
+
+ return Result_N;
+ end Time_Of;
+ end Formatting_Operations;
+
+ ---------------------------
+ -- Time_Zones_Operations --
+ ---------------------------
+
+ package body Time_Zones_Operations is
+
+ -- The Unix time bounds in seconds: 1970/1/1 .. 2037/1/1
+
+ Unix_Min : constant Time :=
+ Time (17 * 366 + 52 * 365 + 2) * Secs_In_Day;
+ -- 1970/1/1
+
+ Unix_Max : constant Time :=
+ Time (34 * 366 + 102 * 365 + 2) * Secs_In_Day +
+ Time (Leap_Seconds_Count);
+ -- 2037/1/1
+
+ -- The following constants denote February 28 during non-leap
+ -- centenial years, the units are nanoseconds.
+
+ T_2100_2_28 : constant Time :=
+ (Time (49 * 366 + 150 * 365 + 59 + 2) * Secs_In_Day +
+ Time (Leap_Seconds_Count)) * Nano;
+
+ T_2200_2_28 : constant Time :=
+ (Time (73 * 366 + 226 * 365 + 59 + 2) * Secs_In_Day +
+ Time (Leap_Seconds_Count)) * Nano;
+
+ T_2300_2_28 : constant Time :=
+ (Time (97 * 366 + 302 * 365 + 59 + 2) * Secs_In_Day +
+ Time (Leap_Seconds_Count)) * Nano;
+
+ -- 56 years (14 leap years + 42 non leap years) in seconds:
+
+ Secs_In_56_Years : constant := (14 * 366 + 42 * 365) * Secs_In_Day;
+
+ -- Base C types. There is no point dragging in Interfaces.C just for
+ -- these four types.
+
+ type char_Pointer is access Character;
+ subtype int is Integer;
+ subtype long is Long_Integer;
+ type long_Pointer is access all long;
+
+ -- The Ada equivalent of struct tm and type time_t
+
+ 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 UTC 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_tzoff
+ (C : time_t_Pointer;
+ res : tm_Pointer;
+ off : long_Pointer);
+ pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
+ -- This is a lightweight wrapper around the system library function
+ -- localtime_r. Parameter 'off' captures the UTC offset which is either
+ -- retrieved from the tm struct or calculated from the 'timezone' extern
+ -- and the tm_isdst flag in the tm struct.
+
+ ---------------------
+ -- UTC_Time_Offset --
+ ---------------------
+
+ function UTC_Time_Offset (Date : Time) return Long_Integer is
+
+ Adj_Cent : Integer := 0;
+ Adj_Date_N : Time;
+ Adj_Date_S : Time;
+ Offset : aliased long;
+ Secs_T : aliased time_t;
+ Secs_TM : aliased tm;
+
+ begin
+ Adj_Date_N := Date;
+
+ -- Dates which are 56 years appart fall on the same day, day light
+ -- saving and so on. Non-leap centenial years violate this rule by
+ -- one day and as a consequence, special adjustment is needed.
+
+ if Adj_Date_N > T_2100_2_28 then
+ if Adj_Date_N > T_2200_2_28 then
+ if Adj_Date_N > T_2300_2_28 then
+ Adj_Cent := 3;
+ else
+ Adj_Cent := 2;
+ end if;
+
+ else
+ Adj_Cent := 1;
+ end if;
+ end if;
+
+ if Adj_Cent > 0 then
+ Adj_Date_N := Adj_Date_N - Time (Adj_Cent) * Nanos_In_Day;
+ end if;
+
+ -- Convert to seconds and shift date within bounds of Unix time
+
+ Adj_Date_S := Adj_Date_N / Nano;
+ while Adj_Date_S < Unix_Min loop
+ Adj_Date_S := Adj_Date_S + Secs_In_56_Years;
+ end loop;
+
+ while Adj_Date_S >= Unix_Max loop
+ Adj_Date_S := Adj_Date_S - Secs_In_56_Years;
end loop;
- end;
- end Leap_Sec_Ops;
+
+ -- Perform a shift in origins from Ada to Unix
+
+ Adj_Date_S := Adj_Date_S - Unix_Min;
+
+ Secs_T := time_t (Adj_Date_S);
+
+ localtime_tzoff
+ (Secs_T'Unchecked_Access,
+ Secs_TM'Unchecked_Access,
+ Offset'Unchecked_Access);
+
+ return Offset;
+ end UTC_Time_Offset;
+ end Time_Zones_Operations;
+
+-- Start of elaboration code for Ada.Calendar
begin
System.OS_Primitives.Initialize;
+
+ -- Population of the leap seconds table
+
+ declare
+ type Leap_Second_Date is record
+ Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ end record;
+
+ Leap_Second_Dates :
+ constant array (1 .. Leap_Seconds_Count) of Leap_Second_Date :=
+ ((1972, 6, 30), (1972, 12, 31), (1973, 12, 31), (1974, 12, 31),
+ (1975, 12, 31), (1976, 12, 31), (1977, 12, 31), (1978, 12, 31),
+ (1979, 12, 31), (1981, 6, 30), (1982, 6, 30), (1983, 6, 30),
+ (1985, 6, 30), (1987, 12, 31), (1989, 12, 31), (1990, 12, 31),
+ (1992, 6, 30), (1993, 6, 30), (1994, 6, 30), (1995, 12, 31),
+ (1997, 6, 30), (1998, 12, 31), (2005, 12, 31));
+
+ Days_In_Four_Years : constant := 365 * 3 + 366;
+
+ Days : Natural;
+ Leap : Leap_Second_Date;
+ Years : Natural;
+
+ begin
+ for Index in 1 .. Leap_Seconds_Count loop
+ Leap := Leap_Second_Dates (Index);
+
+ -- Calculate the number of days from the start of Ada time until
+ -- the current leap second occurence. Non-leap centenial years
+ -- are not accounted for in these calculations since there are
+ -- no leap seconds after 2100 yet.
+
+ Years := Leap.Year - Ada_Min_Year;
+ Days := (Years / 4) * Days_In_Four_Years;
+ Years := Years mod 4;
+
+ if Years = 1 then
+ Days := Days + 365;
+
+ elsif Years = 2 then
+ Days := Days + 365 * 2;
+
+ elsif Years = 3 then
+ Days := Days + 365 * 3;
+ end if;
+
+ Days := Days + Cumulative_Days_Before_Month (Leap.Month);
+
+ if Is_Leap (Leap.Year)
+ and then Leap.Month > 2
+ then
+ Days := Days + 1;
+ end if;
+
+ Days := Days + Leap.Day;
+
+ -- Index - 1 previous leap seconds are added to Time (Index) as
+ -- well as the lower buffer for time zones.
+
+ Leap_Second_Times (Index) := Ada_Low +
+ (Time (Days) * Secs_In_Day + Time (Index - 1)) * Nano;
+ end loop;
+ end;
+
end Ada.Calendar;
-- these do NOT constrain the possible stored values of time which may well
-- permit a larger range of times (this is explicitly allowed in Ada 95).
- subtype Year_Number is Integer range 1901 .. 2099;
+ subtype Year_Number is Integer range 1901 .. 2399;
subtype Month_Number is Integer range 1 .. 12;
subtype Day_Number is Integer range 1 .. 31;
+ -- A Day_Duration value of 86_400.0 designates a new day
+
subtype Day_Duration is Duration range 0.0 .. 86_400.0;
function Clock return Time;
+ -- The returned time value is the number of nanoseconds since the start
+ -- of Ada time (1901-1-1 0.0 GMT).
function Year (Date : Time) return Year_Number;
function Month (Date : Time) return Month_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration);
+ -- Break down a time value into its date components set in the current
+ -- time zone. If Split is called on a time value created using Ada 2005
+ -- Time_Of in some arbitrary time zone, the input value always will be
+ -- interpreted as some point in time relative to the local time zone.
function Time_Of
(Year : Year_Number;
function "+" (Left : Duration; Right : Time) return Time;
function "-" (Left : Time; Right : Duration) return Time;
function "-" (Left : Time; Right : Time) return Duration;
+ -- The first three functions will raise Time_Error if the resulting time
+ -- value is less than the start of Ada time in GMT or greater than the
+ -- end of Ada time in GMT. The last function will raise Time_Error if the
+ -- resulting difference cannot fit into a duration value.
function "<" (Left, Right : Time) return Boolean;
function "<=" (Left, Right : Time) return Boolean;
pragma Inline (">");
pragma Inline (">=");
- -- Time is represented as a signed duration from the base point which is
- -- what Unix calls the EPOCH (i.e. 12 midnight (24:00:00), Dec 31st, 1969,
- -- or if you prefer 0:00:00 on Jan 1st, 1970). Since Ada allows dates
- -- before this EPOCH value, the stored duration value may be negative.
-
- -- The time value stored is typically a GMT value, as provided in standard
- -- Unix environments. If this is the case then Split and Time_Of perform
- -- required conversions to and from local times. The range of times that
- -- can be stored in Time values depends on the declaration of the type
- -- Duration, which must at least cover the required Ada range represented
- -- by the declaration of Year_Number, but may be larger (we take full
- -- advantage of the new permission in Ada 95 to store time values outside
- -- the range that would be acceptable to Split). The Duration type is a
- -- real value representing a time interval in seconds.
-
- type Time is new Duration;
-
- -- The following package provides handling of leap seconds. It is
- -- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both
- -- Ada 2005 children of Ada.Calendar.
-
- package Leap_Sec_Ops is
-
- After_Last_Leap : constant Time := Time'Last;
- -- Bigger by far than any leap second value. Not within range of
- -- Ada.Calendar specified dates.
-
- procedure Cumulative_Leap_Secs
- (Start_Date : Time;
- End_Date : Time;
- Leaps_Between : out Duration;
- Next_Leap_Sec : out Time);
- -- Leaps_Between is the sum of the leap seconds that have occured
- -- on or after Start_Date and before (strictly before) End_Date.
- -- Next_Leap_Sec represents the next leap second occurence on or
- -- after End_Date. If there are no leaps seconds after End_Date,
- -- After_Last_Leap is returned. This does not provide info about
- -- the next leap second (pos/neg or ?). After_Last_Leap can be used
- -- as End_Date to count all the leap seconds that have occured on
- -- or after Start_Date.
- --
- -- Important Notes: any fractional parts of Start_Date and End_Date
- -- are discarded before the calculations are done. For instance: if
- -- 113 seconds is a leap second (it isn't) and 113.5 is input as an
- -- End_Date, the leap second at 113 will not be counted in
- -- Leaps_Between, but it will be returned as Next_Leap_Sec. Thus, if
- -- the caller wants to know if the End_Date is a leap second, the
- -- comparison should be:
- --
- -- End_Date >= Next_Leap_Sec;
- --
- -- After_Last_Leap is designed so that this comparison works without
- -- having to first check if Next_Leap_Sec is a valid leap second.
-
- function All_Leap_Seconds return Duration;
- -- Returns the sum off all of the leap seoncds.
-
- end Leap_Sec_Ops;
-
- procedure Split_With_Offset
- (Date : Time;
- Year : out Year_Number;
- Month : out Month_Number;
- Day : out Day_Number;
- Seconds : out Day_Duration;
- Offset : out Long_Integer);
- -- Split_W_Offset has the same spec as Split with the addition of an
- -- offset value which give the offset of the local time zone from UTC
- -- at the input Date. This value comes for free during the implementation
- -- of Split and is needed by UTC_Time_Offset. The returned Offset time
- -- is straight from the C tm struct and is in seconds. If the system
- -- dependent code has no way to find the offset it will return the value
- -- Invalid_TZ_Offset declared below. Otherwise no checking is done, so
- -- it is up to the user to check both for Invalid_TZ_Offset and otherwise
- -- for a value that is acceptable.
-
- Invalid_TZ_Offset : Long_Integer;
- pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff");
+ -- The units used in this version of Ada.Calendar are nanoseconds. The
+ -- following constants provide values used in conversions of seconds or
+ -- days to the underlying units.
+
+ Nano : constant := 1_000_000_000;
+ Nano_F : constant := 1_000_000_000.0;
+ Nanos_In_Day : constant := 86_400_000_000_000;
+ Secs_In_Day : constant := 86_400;
+
+ ----------------------------
+ -- Implementation of Time --
+ ----------------------------
+
+ -- Time is represented as an unsigned 64 bit integer count of nanoseconds
+ -- since the start of Ada time (1901-1-1 0.0 GMT). Time values produced
+ -- by Time_Of are internaly normalized to GMT regardless of their local
+ -- time zone. This representation ensures correct handling of leap seconds
+ -- as well as performing arithmetic. In Ada 95, Split will treat a time
+ -- value as being in the local time zone and break it down accordingly.
+ -- In Ada 2005, Split will treat a time value as being in the designated
+ -- time zone by the corresponding formal parameter or in GMT by default.
+ -- The size of the type is large enough to cover the Ada 2005 range of
+ -- time (1901-1-1 0.0 GMT - 2399-12-31-86_399.999999999 GMT).
+
+ ------------------
+ -- Leap seconds --
+ ------------------
+
+ -- Due to Earth's slowdown, the astronomical time is not as precise as the
+ -- International Atomic Time. To compensate for this inaccuracy, a single
+ -- leap second is added after the last day of June or December. The count
+ -- of seconds during those occurences becomes:
+
+ -- ... 58, 59, leap second 60, 1, 2 ...
+
+ -- Unlike leap days, leap seconds occur simultaneously around the world.
+ -- In other words, if a leap second occurs at 23:59:60 GMT, it also occurs
+ -- on 18:59:60 -5 or 2:59:60 +2 on the next day.
+ -- Leap seconds do not follow a formula. The International Earth Rotation
+ -- and Reference System Service decides when to add one. Leap seconds are
+ -- included in the representation of time in Ada 95 mode. As a result,
+ -- the following two time values will conceptually differ by two seconds:
+
+ -- Time_Of (1972, 7, 1, 0.0) - Time_Of (1972, 6, 30, 86_399.0) = 2 secs
+
+ -- When a new leap second is added, the following steps must be carried
+ -- out:
+
+ -- 1) Increment Leap_Seconds_Count by one
+ -- 2) Add an entry to the end of table Leap_Second_Dates
+
+ -- The algorithms that build the actual leap second values and discover
+ -- how many leap seconds have occured between two dates do not need any
+ -- modification.
+
+ ------------------------------
+ -- Non-leap centenial years --
+ ------------------------------
+
+ -- Over the range of Ada time, centenial years 2100, 2200 and 2300 are
+ -- non-leap. As a consequence, seven non-leap years occur over the period
+ -- of year - 4 to year + 4. Internaly, routines Split and Time_Of add or
+ -- subtract a "fake" February 29 to facilitate the arithmetic involved.
+ -- This small "cheat" remains hidden and the following calculations do
+ -- produce the correct difference.
+
+ -- Time_Of (2100, 3, 1, 0.0) - Time_Of (2100, 2, 28, 0.0) = 1 day
+ -- Time_Of (2101, 1, 1, 0.0) - Time_Of (2100, 12, 31, 0.0) = 1 day
+
+ type Time_Rep is mod 2 ** 64;
+ type Time is new Time_Rep;
+
+ -- Due to boundary time values and time zones, two days of buffer space
+ -- are set aside at both end points of Ada time:
+
+ -- Abs zero Hard low Soft low Soft high Hard high
+ -- +---------+============+#################+============+----------->
+ -- Buffer 1 Real Ada time Buffer 2
+
+ -- A time value in a any time zone may not excede the hard bounds of Ada
+ -- time, while a value in GMT may not go over the soft bounds.
+
+ Buffer_D : constant Duration := 2.0 * Secs_In_Day;
+ Buffer_N : constant Time := 2 * Nanos_In_Day;
+
+ -- Lower and upper bound of Ada time shifted by two days from the absolute
+ -- zero. Note that the upper bound includes the non-leap centenial years.
+
+ Ada_Low : constant Time := Buffer_N;
+ Ada_High : constant Time := (121 * 366 + 378 * 365) * Nanos_In_Day +
+ Buffer_N;
+
+ -- Both of these hard bounds are 28 hours before and after their regular
+ -- counterpart. The value of 28 is taken from Ada.Calendar.Time_Zones.
+
+ Hard_Ada_Low : constant Time := Ada_Low - 100_800 * Nano;
+ Hard_Ada_High : constant Time := Ada_High + 100_800 * Nano;
+
+ Days_In_Month : constant array (Month_Number) of Day_Number :=
+ (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+
+ Invalid_Time_Zone_Offset : Long_Integer;
+ pragma Import (C, Invalid_Time_Zone_Offset, "__gnat_invalid_tzoff");
+
+ function Is_Leap (Year : Year_Number) return Boolean;
+ -- Determine whether a given year is leap
+
+ -- The following packages provide a target independent interface to the
+ -- children of Calendar - Arithmetic, Delays, Formatting and Time_Zones.
+
+ package Arithmetic_Operations is
+ function Add (Date : Time; Days : Long_Integer) return Time;
+ -- Add X number of days to a time value
+
+ procedure Difference
+ (Left : Time;
+ Right : Time;
+ Days : out Long_Integer;
+ Seconds : out Duration;
+ Leap_Seconds : out Integer);
+ -- Calculate the difference between two time values in terms of days,
+ -- seconds and leap seconds elapsed. The leap seconds are not included
+ -- in the seconds returned. If Left is greater than Right, the returned
+ -- values are positive, negative otherwise.
+
+ function Subtract (Date : Time; Days : Long_Integer) return Time;
+ -- Subtract X number of days from a time value
+ end Arithmetic_Operations;
+
+ package Delays_Operations is
+ function To_Duration (Ada_Time : Time) return Duration;
+ -- Given a time value in nanoseconds since 1901, convert it into a
+ -- duration value giving the number of nanoseconds since the Unix Epoch.
+ end Delays_Operations;
+
+ package Formatting_Operations is
+ function Day_Of_Week (Date : Time) return Integer;
+ -- Determine which day of week Date falls on. The returned values are
+ -- within the range of 0 .. 6 (Monday .. Sunday).
+
+ procedure Split
+ (Date : Time;
+ Year : out Year_Number;
+ Month : out Month_Number;
+ Day : out Day_Number;
+ Day_Secs : out Day_Duration;
+ Hour : out Integer;
+ Minute : out Integer;
+ Second : out Integer;
+ Sub_Sec : out Duration;
+ Leap_Sec : out Boolean;
+ Time_Zone : Long_Integer);
+ -- Split a time value into its components
+
+ function Time_Of
+ (Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Day_Secs : Day_Duration;
+ Hour : Integer;
+ Minute : Integer;
+ Second : Integer;
+ Sub_Sec : Duration;
+ Leap_Sec : Boolean;
+ Leap_Checks : Boolean;
+ Use_Day_Secs : Boolean;
+ Time_Zone : Long_Integer) return Time;
+ -- Given all the components of a date, return the corresponding time
+ -- value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the
+ -- day duration will be calculated from Hour, Minute, Second and Sub_
+ -- Sec. Set flag Leap_Checks to verify the validity of a leap second.
+
+ end Formatting_Operations;
+
+ package Time_Zones_Operations is
+ function UTC_Time_Offset (Date : Time) return Long_Integer;
+ -- Return the offset in seconds from GMT
+ end Time_Zones_Operations;
end Ada.Calendar;
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
-with Unchecked_Conversion;
package body Ada.Calendar.Formatting is
- use Leap_Sec_Ops;
+ --------------------------
+ -- Implementation Notes --
+ --------------------------
- Days_In_4_Years : constant := 365 * 3 + 366;
- Seconds_In_Day : constant := 86_400;
- Seconds_In_4_Years : constant := Days_In_4_Years * Seconds_In_Day;
- Seconds_In_Non_Leap_Year : constant := 365 * Seconds_In_Day;
-
- -- Exact time bounds for the range of Ada time: January 1, 1901 -
- -- December 31, 2099. These bounds are based on the Unix Time of Epoc,
- -- January 1, 1970. Start of Time is -69 years from TOE while End of
- -- time is +130 years and one second from TOE.
-
- Start_Of_Time : constant Time :=
- Time (-(17 * Seconds_In_4_Years +
- Seconds_In_Non_Leap_Year));
-
- End_Of_Time : constant Time :=
- Time (32 * Seconds_In_4_Years +
- 2 * Seconds_In_Non_Leap_Year) +
- All_Leap_Seconds;
-
- Days_In_Month : constant array (Month_Number) of Day_Number :=
- (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+ -- All operations in this package are target and time representation
+ -- independent, thus only one source file is needed for multiple targets.
procedure Check_Char (S : String; C : Character; Index : Integer);
-- Subsidiary to the two versions of Value. Determine whether the
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ H : Hour_Number;
+ Mi : Minute_Number;
+ Se : Second_Number;
+ Ss : Second_Duration;
+ Le : Boolean;
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
- return Day;
+ Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
+ return D;
end Day;
-----------------
-----------------
function Day_Of_Week (Date : Time) return Day_Name is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
-
- D : Duration;
- Day_Count : Long_Long_Integer;
- Midday_Date : Time;
- Secs_Count : Long_Long_Integer;
-
begin
- -- Split the Date to obtain the year, month and day, then build a time
- -- value for the middle of the same day, so that we don't have to worry
- -- about leap seconds in the subsequent arithmetic.
-
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second);
-
- Midday_Date := Time_Of (Year, Month, Day, 12, 0, 0);
- D := Midday_Date - Start_Of_Time;
-
- -- D is a positive Duration value counting seconds since 1901. Convert
- -- it into an integer for ease of arithmetic.
-
- declare
- type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
- for D_Int'Size use Duration'Size;
-
- function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
-
- D_As_Int : constant D_Int := To_D_Int (D);
- Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
-
- begin
- Secs_Count := Long_Long_Integer (D_As_Int / Small_Div);
- end;
-
- Day_Count := Secs_Count / Seconds_In_Day;
- Day_Count := Day_Count + 1; -- Jan 1, 1901 was a Tuesday;
-
- return Day_Name'Val (Day_Count mod 7);
+ return Day_Name'Val (Formatting_Operations.Day_Of_Week (Date));
end Day_Of_Week;
----------
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ H : Hour_Number;
+ Mi : Minute_Number;
+ Se : Second_Number;
+ Ss : Second_Duration;
+ Le : Boolean;
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
- return Hour;
+ Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
+ return H;
end Hour;
-----------
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
-
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ H : Hour_Number;
+ Mi : Minute_Number;
+ Se : Second_Number;
+ Ss : Second_Duration;
+ Le : Boolean;
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
- return Minute;
+ Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
+ return Mi;
end Minute;
-----------
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
-
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ H : Hour_Number;
+ Mi : Minute_Number;
+ Se : Second_Number;
+ Ss : Second_Duration;
+ Le : Boolean;
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
- return Month;
+ Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
+ return Mo;
end Month;
------------
------------
function Second (Date : Time) return Second_Number is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
-
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ H : Hour_Number;
+ Mi : Minute_Number;
+ Se : Second_Number;
+ Ss : Second_Duration;
+ Le : Boolean;
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second);
- return Second;
+ Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
+ return Se;
end Second;
----------------
raise Constraint_Error;
end if;
- return Day_Duration (Hour * 3600) +
- Day_Duration (Minute * 60) +
- Day_Duration (Second) +
+ return Day_Duration (Hour * 3_600) +
+ Day_Duration (Minute * 60) +
+ Day_Duration (Second) +
Sub_Second;
end Seconds_Of;
end if;
Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
- Hour := Hour_Number (Secs / 3600);
- Secs := Secs mod 3600;
+ Hour := Hour_Number (Secs / 3_600);
+ Secs := Secs mod 3_600;
Minute := Minute_Number (Secs / 60);
Second := Second_Number (Secs mod 60);
+
+ -- Validity checks
+
+ if not Hour'Valid
+ or else not Minute'Valid
+ or else not Second'Valid
+ or else not Sub_Second'Valid
+ then
+ raise Time_Error;
+ end if;
end Split;
-----------
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0)
is
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
+ H : Integer;
+ M : Integer;
+ Se : Integer;
+ Su : Duration;
+ Tz : constant Long_Integer := Long_Integer (Time_Zone);
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
+ Formatting_Operations.Split
+ (Date, Year, Month, Day, Seconds, H, M, Se, Su, Leap_Second, Tz);
+
+ -- Validity checks
- Seconds := Seconds_Of (Hour, Minute, Second, Sub_Second);
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else not Seconds'Valid
+ then
+ raise Time_Error;
+ end if;
end Split;
-----------
Sub_Second : out Second_Duration;
Time_Zone : Time_Zones.Time_Offset := 0)
is
- Leap_Second : Boolean;
+ Dd : Day_Duration;
+ Le : Boolean;
+ Tz : constant Long_Integer := Long_Integer (Time_Zone);
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
+ Formatting_Operations.Split
+ (Date, Year, Month, Day, Dd,
+ Hour, Minute, Second, Sub_Second, Le, Tz);
+
+ -- Validity checks
+
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else not Hour'Valid
+ or else not Minute'Valid
+ or else not Second'Valid
+ or else not Sub_Second'Valid
+ then
+ raise Time_Error;
+ end if;
end Split;
-----------
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0)
is
- Ada_Year_Min : constant Year_Number := Year_Number'First;
- Day_In_Year : Integer;
- Day_Second : Integer;
- Elapsed_Leaps : Duration;
- Hour_Second : Integer;
- In_Leap_Year : Boolean;
- Modified_Date : Time;
- Next_Leap : Time;
- Remaining_Years : Integer;
- Seconds_Count : Long_Long_Integer;
+ Dd : Day_Duration;
+ Tz : constant Long_Integer := Long_Integer (Time_Zone);
begin
- -- Our measurement of time is the number of seconds that have elapsed
- -- since the Unix TOE. To calculate a UTC date from this we do a
- -- sequence of divides and mods to get the components of a date based
- -- on 86,400 seconds in each day. Since, UTC time depends upon the
- -- occasional insertion of leap seconds, the number of leap seconds
- -- that have been added prior to the input time are then subtracted
- -- from the previous calculation. In fact, it is easier to do the
- -- subtraction first, so a more accurate discription of what is
- -- actually done, is that the number of added leap seconds is looked
- -- up using the input Time value, than that number of seconds is
- -- subtracted before the sequence of divides and mods.
- --
- -- If the input date turns out to be a leap second, we don't add it to
- -- date (we want to return 23:59:59) but we set the Leap_Second output
- -- to true.
-
- -- Is there a need to account for a difference from Unix time prior
- -- to the first leap second ???
-
- -- Step 1: Determine the number of leap seconds since the start
- -- of Ada time and the input date as well as the next leap second
- -- occurence and process accordingly.
-
- Cumulative_Leap_Secs (Start_Of_Time, Date, Elapsed_Leaps, Next_Leap);
-
- Leap_Second := Date >= Next_Leap;
- Modified_Date := Date - Elapsed_Leaps;
-
- if Leap_Second then
- Modified_Date := Modified_Date - Duration (1.0);
- end if;
+ Formatting_Operations.Split
+ (Date, Year, Month, Day, Dd,
+ Hour, Minute, Second, Sub_Second, Leap_Second, Tz);
- -- Step 2: Process the time zone
-
- Modified_Date := Modified_Date + Duration (Time_Zone * 60);
-
- -- Step 3: Sanity check on the calculated date. Since the leap
- -- seconds and the time zone have been eliminated, the result needs
- -- to be within the range of Ada time.
+ -- Validity checks
- if Modified_Date < Start_Of_Time
- or else Modified_Date >= (End_Of_Time - All_Leap_Seconds)
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else not Hour'Valid
+ or else not Minute'Valid
+ or else not Second'Valid
+ or else not Sub_Second'Valid
then
raise Time_Error;
end if;
-
- Modified_Date := Modified_Date - Start_Of_Time;
-
- declare
- type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
- for D_Int'Size use Duration'Size;
-
- function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
- function To_Duration is new Unchecked_Conversion (D_Int, Duration);
- function To_Duration is new Unchecked_Conversion (Time, Duration);
-
- D_As_Int : constant D_Int := To_D_Int (To_Duration (Modified_Date));
- Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
-
- begin
- Seconds_Count := Long_Long_Integer (D_As_Int / Small_Div);
- Sub_Second := Second_Duration
- (To_Duration (D_As_Int rem Small_Div));
- end;
-
- -- Step 4: Calculate the number of years since the start of Ada time.
- -- First consider sequences of four years, then the remaining years.
-
- Year := Ada_Year_Min + 4 * Integer (Seconds_Count / Seconds_In_4_Years);
- Seconds_Count := Seconds_Count mod Seconds_In_4_Years;
- Remaining_Years := Integer (Seconds_Count / Seconds_In_Non_Leap_Year);
-
- if Remaining_Years > 3 then
- Remaining_Years := 3;
- end if;
-
- Year := Year + Remaining_Years;
-
- -- Remove the seconds elapsed in those remaining years
-
- Seconds_Count := Seconds_Count - Long_Long_Integer
- (Remaining_Years * Seconds_In_Non_Leap_Year);
- In_Leap_Year := (Year mod 4) = 0;
-
- -- Step 5: Month and day processing. Determine the day to which the
- -- remaining seconds map to.
-
- Day_In_Year := Integer (Seconds_Count / Seconds_In_Day) + 1;
-
- Month := 1;
-
- if Day_In_Year > 31 then
- Month := 2;
- Day_In_Year := Day_In_Year - 31;
-
- if Day_In_Year > 28
- and then ((not In_Leap_Year)
- or else Day_In_Year > 29)
- then
- Month := 3;
- Day_In_Year := Day_In_Year - 28;
-
- if In_Leap_Year then
- Day_In_Year := Day_In_Year - 1;
- end if;
-
- while Day_In_Year > Days_In_Month (Month) loop
- Day_In_Year := Day_In_Year - Days_In_Month (Month);
- Month := Month + 1;
- end loop;
- end if;
- end if;
-
- -- Step 6: Hour, minute and second processing
-
- Day := Day_In_Year;
- Day_Second := Integer (Seconds_Count mod Seconds_In_Day);
- Hour := Day_Second / 3600;
- Hour_Second := Day_Second mod 3600;
- Minute := Hour_Second / 60;
- Second := Hour_Second mod 60;
end Split;
----------------
----------------
function Sub_Second (Date : Time) return Second_Duration is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
-
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ H : Hour_Number;
+ Mi : Minute_Number;
+ Se : Second_Number;
+ Ss : Second_Duration;
+ Le : Boolean;
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second);
-
- return Sub_Second;
+ Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
+ return Ss;
end Sub_Second;
-------------
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time
is
- Hour : Hour_Number;
- Minute : Minute_Number;
- Sec_Num : Second_Number;
- Sub_Sec : Second_Duration;
- Whole_Part : Integer;
+ Adj_Year : Year_Number := Year;
+ Adj_Month : Month_Number := Month;
+ Adj_Day : Day_Number := Day;
+
+ H : constant Integer := 1;
+ M : constant Integer := 1;
+ Se : constant Integer := 1;
+ Ss : constant Duration := 0.1;
+ Tz : constant Long_Integer := Long_Integer (Time_Zone);
begin
- if not Seconds'Valid then
+ -- Validity checks
+
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else not Seconds'Valid
+ or else not Time_Zone'Valid
+ then
raise Constraint_Error;
end if;
- -- The fact that Seconds can go to 86,400 creates all this extra work.
- -- Perhaps a Time_Of just like the next one but allowing the Second_
- -- Number input to reach 60 should become an internal version that this
- -- and the next version call.... but for now we do the ugly bumping up
- -- of Day, Month and Year;
+ -- A Seconds value of 86_400 denotes a new day. This case requires an
+ -- adjustment to the input values.
if Seconds = 86_400.0 then
- declare
- Adj_Year : Year_Number := Year;
- Adj_Month : Month_Number := Month;
- Adj_Day : Day_Number := Day;
-
- begin
- Hour := 0;
- Minute := 0;
- Sec_Num := 0;
- Sub_Sec := 0.0;
-
- if Day < Days_In_Month (Month)
- or else (Month = 2
- and then Year mod 4 = 0)
- then
- Adj_Day := Day + 1;
+ if Day < Days_In_Month (Month)
+ or else (Is_Leap (Year)
+ and then Month = 2)
+ then
+ Adj_Day := Day + 1;
+ else
+ Adj_Day := 1;
+
+ if Month < 12 then
+ Adj_Month := Month + 1;
else
- Adj_Day := 1;
-
- if Month < 12 then
- Adj_Month := Month + 1;
- else
- Adj_Month := 1;
- Adj_Year := Year + 1;
- end if;
+ Adj_Month := 1;
+ Adj_Year := Year + 1;
end if;
-
- return Time_Of (Adj_Year, Adj_Month, Adj_Day, Hour, Minute,
- Sec_Num, Sub_Sec, Leap_Second, Time_Zone);
- end;
+ end if;
end if;
- declare
- type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
- for D_Int'Size use Duration'Size;
-
- function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
- function To_Duration is new Unchecked_Conversion (D_Int, Duration);
-
- D_As_Int : constant D_Int := To_D_Int (Seconds);
- Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
-
- begin
- Whole_Part := Integer (D_As_Int / Small_Div);
- Sub_Sec := Second_Duration
- (To_Duration (D_As_Int rem Small_Div));
- end;
-
- Hour := Hour_Number (Whole_Part / 3600);
- Whole_Part := Whole_Part mod 3600;
- Minute := Minute_Number (Whole_Part / 60);
- Sec_Num := Second_Number (Whole_Part mod 60);
-
- return Time_Of (Year, Month, Day,
- Hour, Minute, Sec_Num, Sub_Sec, Leap_Second, Time_Zone);
+ return
+ Formatting_Operations.Time_Of
+ (Adj_Year, Adj_Month, Adj_Day, Seconds, H, M, Se, Ss,
+ Leap_Sec => Leap_Second,
+ Leap_Checks => True,
+ Use_Day_Secs => True,
+ Time_Zone => Tz);
end Time_Of;
-------------
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time
is
- Cumulative_Days_Before_Month :
- constant array (Month_Number) of Natural :=
- (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
-
- Ada_Year_Min : constant Year_Number := Year_Number'First;
- Count : Integer;
- Elapsed_Leap_Seconds : Duration;
- Fractional_Second : Duration;
- Next_Leap : Time;
- Result : Time;
+ Dd : constant Day_Duration := Day_Duration'First;
+ Tz : constant Long_Integer := Long_Integer (Time_Zone);
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).
+ -- Validity checks
if not Year'Valid
or else not Month'Valid
raise Constraint_Error;
end if;
- -- Start the accumulation from the beginning of Ada time
-
- Result := Start_Of_Time;
-
- -- Step 1: Determine the number of leap and non-leap years since 1901
- -- and the input date.
-
- -- Count the number of four year segments
-
- Count := (Year - Ada_Year_Min) / 4;
- Result := Result + Duration (Count * Seconds_In_4_Years);
-
- -- Count the number of remaining non-leap years
-
- Count := (Year - Ada_Year_Min) mod 4;
- Result := Result + Duration (Count * Seconds_In_Non_Leap_Year);
-
- -- Step 2: Determine the number of days elapsed singe the start of the
- -- input year and add them to the result.
-
- -- Do not include the current day since it is not over yet
-
- Count := Cumulative_Days_Before_Month (Month) + Day - 1;
-
- -- The input year is a leap year and we have passed February
-
- if (Year mod 4) = 0
- and then Month > 2
- then
- Count := Count + 1;
- end if;
-
- Result := Result + Duration (Count * Seconds_In_Day);
-
- -- Step 3: Hour, minute and second processing
-
- Result := Result + Duration (Hour * 3600) +
- Duration (Minute * 60) +
- Duration (Second);
-
- -- The sub second may designate a whole second
-
- if Sub_Second = 1.0 then
- Result := Result + Duration (1.0);
- Fractional_Second := 0.0;
- else
- Fractional_Second := Sub_Second;
- end if;
-
- -- Step 4: Time zone processing
-
- Result := Result - Duration (Time_Zone * 60);
-
- -- Step 5: The caller wants a leap second
-
- if Leap_Second then
- Result := Result + Duration (1.0);
- end if;
-
- -- Step 6: Calculate the number of leap seconds occured since the
- -- start of Ada time and the current point in time. The following
- -- is an approximation which does not yet count leap seconds. It
- -- can be pushed beyond 1 leap second, but not more.
-
- Cumulative_Leap_Secs
- (Start_Of_Time, Result, Elapsed_Leap_Seconds, Next_Leap);
-
- Result := Result + Elapsed_Leap_Seconds;
-
- -- Step 7: Validity check of a leap second occurence. It requires an
- -- additional comparison to Next_Leap to ensure that we landed right
- -- on a valid occurence and that Elapsed_Leap_Seconds did not shoot
- -- past it.
-
- if Leap_Second
- and then
- not (Result >= Next_Leap
- and then Result - Duration (1.0) < Next_Leap)
- then
- raise Time_Error;
- end if;
-
- -- Step 8: Final sanity check on the calculated duration value
-
- if Result < Start_Of_Time
- or else Result >= End_Of_Time
- then
- raise Time_Error;
- end if;
-
- -- Step 9: Lastly, add the sub second part
-
- return Result + Fractional_Second;
+ return
+ Formatting_Operations.Time_Of
+ (Year, Month, Day, Dd, Hour, Minute, Second, Sub_Second,
+ Leap_Sec => Leap_Second,
+ Leap_Checks => True,
+ Use_Day_Secs => False,
+ Time_Zone => Tz);
end Time_Of;
-----------
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Hour : Hour_Number;
- Minute : Minute_Number;
- Second : Second_Number;
- Sub_Second : Second_Duration;
- Leap_Second : Boolean;
+ Y : Year_Number;
+ Mo : Month_Number;
+ D : Day_Number;
+ H : Hour_Number;
+ Mi : Minute_Number;
+ Se : Second_Number;
+ Ss : Second_Duration;
+ Le : Boolean;
begin
- Split (Date, Year, Month, Day,
- Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
- return Year;
+ Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
+ return Y;
end Year;
end Ada.Calendar.Formatting;
-- --
-- S p e c --
-- --
--- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- --
------------------------------------------------------------------------------
+-- This package provides additional components to Time, as well as new
+-- Time_Of and Split routines which handle time zones and leap seconds.
+-- This package is defined in the Ada 2005 RM (9.6.1).
+
with Ada.Calendar.Time_Zones;
package Ada.Calendar.Formatting is
Minute : Minute_Number;
Second : Second_Number := 0;
Sub_Second : Second_Duration := 0.0) return Day_Duration;
+ -- Returns a Day_Duration value for the combination of the given Hour,
+ -- Minute, Second, and Sub_Second. This value can be used in Ada.Calendar.
+ -- Time_Of as well as the argument to Calendar."+" and Calendar."–". If
+ -- Seconds_Of is called with a Sub_Second value of 1.0, the value returned
+ -- is equal to the value of Seconds_Of for the next second with a Sub_
+ -- Second value of 0.0.
procedure Split
(Seconds : Day_Duration;
Minute : out Minute_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration);
+ -- Splits Seconds into Hour, Minute, Second and Sub_Second in such a way
+ -- that the resulting values all belong to their respective subtypes. The
+ -- value returned in the Sub_Second parameter is always less than 1.0.
procedure Split
(Date : Time;
Second : out Second_Number;
Sub_Second : out Second_Duration;
Time_Zone : Time_Zones.Time_Offset := 0);
+ -- Splits Date into its constituent parts (Year, Month, Day, Hour, Minute,
+ -- Second, Sub_Second), relative to the specified time zone offset. The
+ -- value returned in the Sub_Second parameter is always less than 1.0.
function Time_Of
(Year : Year_Number;
Sub_Second : Second_Duration := 0.0;
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time;
+ -- If Leap_Second is False, returns a Time built from the date and time
+ -- values, relative to the specified time zone offset. If Leap_Second is
+ -- True, returns the Time that represents the time within the leap second
+ -- that is one second later than the time specified by the parameters.
+ -- Time_Error is raised if the parameters do not form a proper date or
+ -- time. If Time_Of is called with a Sub_Second value of 1.0, the value
+ -- returned is equal to the value of Time_Of for the next second with a
+ -- Sub_Second value of 0.0.
function Time_Of
(Year : Year_Number;
Seconds : Day_Duration := 0.0;
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time;
+ -- If Leap_Second is False, returns a Time built from the date and time
+ -- values, relative to the specified time zone offset. If Leap_Second is
+ -- True, returns the Time that represents the time within the leap second
+ -- that is one second later than the time specified by the parameters.
+ -- Time_Error is raised if the parameters do not form a proper date or
+ -- time. If Time_Of is called with a Seconds value of 86_400.0, the value
+ -- returned is equal to the value of Time_Of for the next day with a
+ -- Seconds value of 0.0.
procedure Split
(Date : Time;
Sub_Second : out Second_Duration;
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0);
+ -- If Date does not represent a time within a leap second, splits Date
+ -- into its constituent parts (Year, Month, Day, Hour, Minute, Second,
+ -- Sub_Second), relative to the specified time zone offset, and sets
+ -- Leap_Second to False. If Date represents a time within a leap second,
+ -- set the constituent parts to values corresponding to a time one second
+ -- earlier than that given by Date, relative to the specified time zone
+ -- offset, and sets Leap_Seconds to True. The value returned in the
+ -- Sub_Second parameter is always less than 1.0.
procedure Split
(Date : Time;
Seconds : out Day_Duration;
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0);
+ -- If Date does not represent a time within a leap second, splits Date
+ -- into its constituent parts (Year, Month, Day, Seconds), relative to the
+ -- specified time zone offset, and sets Leap_Second to False. If Date
+ -- represents a time within a leap second, set the constituent parts to
+ -- values corresponding to a time one second earlier than that given by
+ -- Date, relative to the specified time zone offset, and sets Leap_Seconds
+ -- to True. The value returned in the Seconds parameter is always less
+ -- than 86_400.0.
-- Simple image and value
(Date : Time;
Include_Time_Fraction : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return String;
+ -- Returns a string form of the Date relative to the given Time_Zone. The
+ -- format is "Year-Month-Day Hour:Minute:Second", where the Year is a
+ -- 4-digit value, and all others are 2-digit values, of the functions
+ -- defined in Ada.Calendar and Ada.Calendar.Formatting, including a
+ -- leading zero, if needed. The separators between the values are a minus,
+ -- another minus, a colon, and a single space between the Day and Hour. If
+ -- Include_Time_Fraction is True, the integer part of Sub_Seconds*100 is
+ -- suffixed to the string as a point followed by a 2-digit value.
function Value
(Date : String;
Time_Zone : Time_Zones.Time_Offset := 0) return Time;
+ -- Returns a Time value for the image given as Date, relative to the given
+ -- time zone. Constraint_Error is raised if the string is not formatted as
+ -- described for Image, or the function cannot interpret the given string
+ -- as a Time value.
function Image
(Elapsed_Time : Duration;
Include_Time_Fraction : Boolean := False) return String;
+ -- Returns a string form of the Elapsed_Time. The format is "Hour:Minute:
+ -- Second", where all values are 2-digit values, including a leading zero,
+ -- if needed. The separators between the values are colons. If Include_
+ -- Time_Fraction is True, the integer part of Sub_Seconds*100 is suffixed
+ -- to the string as a point followed by a 2-digit value. If Elapsed_Time <
+ -- 0.0, the result is Image (abs Elapsed_Time, Include_Time_Fraction)
+ -- prefixed with a minus sign. If abs Elapsed_Time represents 100 hours or
+ -- more, the result is implementation-defined.
function Value (Elapsed_Time : String) return Duration;
+ -- Returns a Duration value for the image given as Elapsed_Time.
+ -- Constraint_Error is raised if the string is not formatted as described
+ -- for Image, or the function cannot interpret the given string as a
+ -- Duration value.
end Ada.Calendar.Formatting;
package body Ada.Calendar.Time_Zones is
+ --------------------------
+ -- Implementation Notes --
+ --------------------------
+
+ -- All operations in this package are target and time representation
+ -- independent, thus only one source file is needed for multiple targets.
+
---------------------
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Seconds : Day_Duration;
- Offset : Long_Integer;
+ Offset_L : constant Long_Integer :=
+ Time_Zones_Operations.UTC_Time_Offset (Date);
+ Offset : Time_Offset;
begin
- Split_With_Offset (Date, Year, Month, Day, Seconds, Offset);
-
- -- The system dependent code does not support time zones
-
- if Offset = Invalid_TZ_Offset then
+ if Offset_L = Invalid_Time_Zone_Offset then
raise Unknown_Zone_Error;
end if;
- Offset := Offset / 60;
+ -- The offset returned by Time_Zones_Operations.UTC_Time_Offset is in
+ -- seconds, the returned value needs to be in minutes.
+
+ Offset := Time_Offset (Offset_L / 60);
+
+ -- Validity checks
- if Offset < Long_Integer (Time_Offset'First)
- or else Offset > Long_Integer (Time_Offset'Last)
- then
+ if not Offset'Valid then
raise Unknown_Zone_Error;
end if;
- return Time_Offset (Offset);
+ return Offset;
end UTC_Time_Offset;
end Ada.Calendar.Time_Zones;
-- --
-- S p e c --
-- --
--- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- --
------------------------------------------------------------------------------
+-- This package provides routines to determine the offset of dates to GMT.
+-- It is defined in the Ada 2005 RM (9.6.1).
+
package Ada.Calendar.Time_Zones is
-- Time zone manipulation
Unknown_Zone_Error : exception;
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset;
+ -- Returns, as a number of minutes, the difference between the
+ -- implementation-defined time zone of Calendar, and UTC time, at the time
+ -- Date. If the time zone of the Calendar implementation is unknown, then
+ -- Unknown_Zone_Error is raised.
end Ada.Calendar.Time_Zones;
-- --
------------------------------------------------------------------------------
+with Ada.Calendar; use Ada.Calendar;
+with Ada.Calendar.Formatting; use Ada.Calendar.Formatting;
with Ada.Directories.Validity; use Ada.Directories.Validity;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
-with Ada.Unchecked_Conversion;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body Ada.Directories is
- function Duration_To_Time is new
- Ada.Unchecked_Conversion (Duration, Ada.Calendar.Time);
- function OS_Time_To_Long_Integer is new
- Ada.Unchecked_Conversion (OS_Time, Long_Integer);
- -- These two unchecked conversions are used in function Modification_Time
- -- to convert an OS_Time to a Calendar.Time.
-
type Search_Data is record
Is_Valid : Boolean := False;
Name : Ada.Strings.Unbounded.Unbounded_String;
-- Modification_Time --
-----------------------
- function Modification_Time (Name : String) return Ada.Calendar.Time is
+ function Modification_Time (Name : String) return Time is
Date : OS_Time;
Year : Year_Type;
Month : Month_Type;
Hour : Hour_Type;
Minute : Minute_Type;
Second : Second_Type;
-
- Result : Ada.Calendar.Time;
+ Result : Time;
begin
-- First, the invalid cases
else
Date := File_Time_Stamp (Name);
- -- ??? This implementation should be revisited when AI 00351 has
- -- implemented.
+ -- Break down the time stamp into its constituents relative to GMT.
+ -- This version of Split does not recognize leap seconds or buffer
+ -- space for time zone processing.
- if OpenVMS then
+ GM_Split (Date, Year, Month, Day, Hour, Minute, Second);
- -- On OpenVMS, OS_Time is in local time
+ -- On OpenVMS, the resulting time value must be in the local time
+ -- zone. Ada.Calendar.Time_Of is exactly what we need. Note that
+ -- in both cases, the sub seconds are set to zero (0.0) because the
+ -- time stamp does not store them in its value.
- GM_Split (Date, Year, Month, Day, Hour, Minute, Second);
+ if OpenVMS then
+ Result :=
+ Ada.Calendar.Time_Of
+ (Year, Month, Day, Seconds_Of (Hour, Minute, Second, 0.0));
- return Ada.Calendar.Time_Of
- (Year, Month, Day,
- Duration (Second + 60 * (Minute + 60 * Hour)));
+ -- On Unix and Windows, the result must be in GMT. Ada.Calendar.
+ -- Formatting.Time_Of with default time zone of zero (0) is the
+ -- routine of choice.
else
- -- On Unix and Windows, OS_Time is in GMT
-
- Result :=
- Duration_To_Time (Duration (OS_Time_To_Long_Integer (Date)));
- return Result;
+ Result := Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0);
end if;
+
+ return Result;
end if;
end Modification_Time;
/* This value is returned as the time zone offset when a valid value
cannot be determined. It is simply a bizarre value that will never
- occur. It is 3 days plus 73 seconds (offset is in seconds. */
+ occur. It is 3 days plus 73 seconds (offset is in seconds). */
long __gnat_invalid_tzoff = 259273;
struct tm *
__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
{
+ /* Treat all time values in GMT */
localtime_r (tp, timer);
- *off = __gnat_invalid_tzoff;
+ *off = 0;
return NULL;
}
/* AIX, HPUX, SGI Irix, Sun Solaris */
#if defined (_AIX) || defined (__hpux__) || defined (sgi) || defined (sun)
- *off = (long) -timezone;
- if (tp->tm_isdst > 0)
- *off = *off + 3600;
+ /* The contents of external variable "timezone" may not always be
+ initialized. Instead of returning an incorrect offset, treat the local
+ time zone as 0 (UTC). The value of 28 hours is the maximum valid offset
+ allowed by Ada.Calendar.Time_Zones. */
+ if ((timezone < -28 * 3600) || (timezone > 28 * 3600))
+ *off = 0;
+ else
+ {
+ *off = (long) -timezone;
+ if (tp->tm_isdst > 0)
+ *off = *off + 3600;
+ }
+/* Lynx - Treat all time values in GMT */
+#elif defined (__Lynx__)
+ *off = 0;
+
+/* VxWorks */
+#elif defined (__vxworks)
+#include <stdlib.h>
+{
+ /* Try to read the environment variable TIMEZONE. The variable may not have
+ been initialize, in that case return an offset of zero (0) for UTC. */
+ char *tz_str = getenv ("TIMEZONE");
-/* Lynx, VXWorks */
-#elif defined (__Lynx__) || defined (__vxworks)
- *off = __gnat_invalid_tzoff;
+ if ((tz_str == NULL) || (*tz_str == '\0'))
+ *off = 0;
+ else
+ {
+ char *tz_start, *tz_end;
+
+ /* The format of the data contained in TIMEZONE is N::U:S:E where N is the
+ name of the time zone, U are the minutes difference from UTC, S is the
+ start of DST in mmddhh and E is the end of DST in mmddhh. Extracting
+ the value of U involves setting two pointers, one at the beginning and
+ one at the end of the value. The end pointer is then set to null in
+ order to delimit a string slice for atol to process. */
+ tz_start = index (tz_str, ':') + 2;
+ tz_end = index (tz_start, ':');
+ tz_end = '\0';
+
+ /* The Ada layer expects an offset in seconds */
+ *off = atol (tz_start) * 60;
+ }
+}
-/* Darwin, Free BSD, Linux, Tru64 */
-#else
+/* Darwin, Free BSD, Linux, Tru64, where there exists a component tm_gmtoff
+ in struct tm */
+#elif defined (__APPLE__) || defined (__FreeBSD__) || defined (linux) ||\
+ (defined (__alpha__) && defined (__osf__))
*off = tp->tm_gmtoff;
+
+/* All other platforms: Treat all time values in GMT */
+#else
+ *off = 0;
#endif
return NULL;
}
#endif
#endif
#endif
+
+#ifdef __vxworks
+
+#include <taskLib.h>
+
+/* __gnat_get_task_options is used by s-taprop.adb only for VxWorks. This
+ function returns the options to be set when creating a new task. It fetches
+ the options assigned to the current task (parent), so offering some user
+ level control over the options for a task hierarchy. It forces VX_FP_TASK
+ because it is almost always required. */
+extern int __gnat_get_task_options (void);
+
+int
+__gnat_get_task_options (void)
+{
+ int options;
+
+ /* Get the options for the task creator */
+ taskOptionsGet (taskIdSelf (), &options);
+
+ /* Force VX_FP_TASK because it is almost always required */
+ options |= VX_FP_TASK;
+
+ /* Mask those bits that are not under user control */
+#ifdef VX_USR_TASK_OPTIONS
+ return options & VX_USR_TASK_OPTIONS;
+#else
+ return options;
+#endif
+}
+
+#endif
+
+#ifdef __Lynx__
+
+/*
+ The following code works around a problem in LynxOS version 4.2. As
+ of that version, the symbol pthread_mutex_lock has been removed
+ from libc and replaced with an inline C function in a system
+ header.
+
+ LynuxWorks has indicated that this is a bug and that they intend to
+ put that symbol back in libc in a future patch level, following
+ which this patch can be removed. However, for the time being we use
+ a wrapper which can be imported from the runtime.
+*/
+
+#include <pthread.h>
+
+int
+__gnat_pthread_mutex_lock (pthread_mutex_t *mutex)
+{
+ return pthread_mutex_lock (mutex);
+}
+
+#endif /* __Lynx__ */
OSDN Git Service
