Skip to content

R
riscv-gcc-1
Commit 42907632 by Hristian Kirtchev Committed by Arnaud Charlet
Options

a-calend-vms.ads, [...]: New version of Ada.Calendar which supports the new… 

a-calend-vms.ads, [...]: New version of Ada.Calendar which supports the new upper bound of Ada time...

2007-04-06  Hristian Kirtchev  <kirtchev@adacore.com>
	    Vincent Celier  <celier@adacore.com>

	* a-calend-vms.ads, a-calend.ads, a-calend.adb, a-calend-vms.adb:
	New version of Ada.Calendar which supports the new upper bound of Ada
	time (2399-12-31 86_399.999999999).
	The following modifications have been made to the package:
	 - New representation of time as count of nanoseconds since the start of
	   Ada time (1901-1-1 0.0).
	 - Target independent Split and Time_Of routines which service both
	   Ada 95 and Ada 2005 code.
	 - Target independent interface to the Ada 2005 children of Calendar.
	 - Integrated leap seconds into Ada 95 and Ada 2005 mode.
	 - Handling of non-leap centenial years.
	 - Updated clock function.
	 - Updated arithmetic and comparison operators.

	* a-caldel.adb (To_Duration): Add call to target independent routine in
	Ada.Calendar to handle the conversion of time to duration.

	* sysdep.c (__gnat_localtime_tzoff): Test timezone before setting off
	(UTC Offset).
	If timezone is obviously incorrect (outside of -14 hours .. 14 hours),
	set off to 0.
	(__gnat_localtime_tzoff for Lynx and VxWorks): Even though these
	targets do not have a natural time zone, GMT is used as a default.
	(__gnat_get_task_options): New.

	* a-direct.adb (Modification_Time): Add with and use clauses for
	Ada.Calendar and Ada.
	Calendar.Formatting. Remove with clause for Ada.Unchecked_Conversion
	since it is no longer needed.
	(Duration_To_Time): Removed.
	(OS_Time_To_Long_Integer): Removed.
	(Modification_Time): Rewritten to use Ada.Calendar and Ada.Calendar.
	Formatting Time_Of routines which automatically handle time zones,
	buffer periods and leap seconds.

	* a-calari.ads, a-calari.adb ("+", "-", Difference): Add calls to
	target independent routines in Ada.Calendar.

	* a-calfor.ads, a-calfor.adb: 
	Code cleanup and addition of validity checks in various routines.
	(Day_Of_Week, Split, Time_Of): Add call to target independent routine in
	Ada.Calendar.

	* a-catizo.ads, a-catizo.adb (UTC_Time_Offset): Add call to target
	independent routine in Ada.Calendar.

From-SVN: r123543
parent 3d3bf932
Showing with 2933 additions and 1411 deletions
gcc/ada/a-calari.adb
......@@ -31,26 +31,29 @@
-- --
------------------------------------------------------------------------------
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 "+";
---------
......@@ -58,18 +61,19 @@ package body Ada.Calendar.Arithmetic is
---------
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 "-";
----------------
......@@ -77,66 +81,19 @@ package body Ada.Calendar.Arithmetic is
----------------
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;
gcc/ada/a-calari.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
......@@ -35,26 +35,51 @@
-- --
------------------------------------------------------------------------------
-- 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;
gcc/ada/a-caldel.adb
......@@ -7,7 +7,7 @@
-- 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- --
......@@ -54,12 +54,12 @@ package body Ada.Calendar.Delays is
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 --
......@@ -120,18 +120,23 @@ package body Ada.Calendar.Delays is
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;
gcc/ada/a-calend-vms.adb
......@@ -35,35 +35,70 @@
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.
---------
-- "+" --
......@@ -71,9 +106,19 @@ package body Ada.Calendar 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 =>
raise Time_Error;
......@@ -82,8 +127,7 @@ package body Ada.Calendar is
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;
......@@ -93,10 +137,21 @@ package body Ada.Calendar is
-- "-" --
---------
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 =>
......@@ -105,9 +160,19 @@ package body Ada.Calendar is
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 =>
......@@ -150,49 +215,180 @@ package body Ada.Calendar is
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;
-------------
......@@ -200,14 +396,13 @@ package body Ada.Calendar is
-------------
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;
-----------
......@@ -221,57 +416,27 @@ package body Ada.Calendar is
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 --
-------------
......@@ -280,137 +445,626 @@ package body Ada.Calendar is
(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;
gcc/ada/a-calend-vms.ads
......@@ -44,11 +44,12 @@ package Ada.Calendar is
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;
......@@ -72,8 +73,7 @@ package Ada.Calendar is
(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;
......@@ -87,10 +87,7 @@ package Ada.Calendar is
Time_Error : exception;
Unimplemented : exception;
private
pragma Inline (Clock);
pragma Inline (Year);
......@@ -105,81 +102,107 @@ private
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;
gcc/ada/a-calend.adb
......@@ -31,100 +31,118 @@
-- --
------------------------------------------------------------------------------
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.
---------
-- "+" --
......@@ -132,30 +150,98 @@ package body Ada.Calendar 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
-- 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;
......@@ -163,8 +249,55 @@ package body Ada.Calendar is
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;
......@@ -176,7 +309,7 @@ package body Ada.Calendar is
function "<" (Left, Right : Time) return Boolean is
begin
return Duration (Left) < Duration (Right);
return Time_Rep (Left) < Time_Rep (Right);
end "<";
----------
......@@ -185,7 +318,7 @@ package body Ada.Calendar is
function "<=" (Left, Right : Time) return Boolean is
begin
return Duration (Left) <= Duration (Right);
return Time_Rep (Left) <= Time_Rep (Right);
end "<=";
---------
......@@ -194,7 +327,7 @@ package body Ada.Calendar is
function ">" (Left, Right : Time) return Boolean is
begin
return Duration (Left) > Duration (Right);
return Time_Rep (Left) > Time_Rep (Right);
end ">";
----------
......@@ -203,7 +336,7 @@ package body Ada.Calendar is
function ">=" (Left, Right : Time) return Boolean is
begin
return Duration (Left) >= Duration (Right);
return Time_Rep (Left) >= Time_Rep (Right);
end ">=";
-----------
......@@ -211,36 +344,179 @@ package body Ada.Calendar is
-----------
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;
-------------
......@@ -248,13 +524,13 @@ package body Ada.Calendar is
-------------
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;
-----------
......@@ -268,438 +544,999 @@ package body Ada.Calendar is
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;
gcc/ada/a-calend.ads
......@@ -43,13 +43,17 @@ package Ada.Calendar is
-- 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;
......@@ -62,6 +66,10 @@ package Ada.Calendar is
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;
......@@ -87,6 +95,10 @@ package Ada.Calendar is
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;
......@@ -110,83 +122,183 @@ private
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;
gcc/ada/a-calfor.adb
......@@ -33,33 +33,15 @@
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
......@@ -102,19 +84,18 @@ package body Ada.Calendar.Formatting is
(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;
-----------------
......@@ -122,51 +103,8 @@ package body Ada.Calendar.Formatting is
-----------------
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;
----------
......@@ -177,19 +115,18 @@ package body Ada.Calendar.Formatting is
(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;
-----------
......@@ -377,19 +314,17 @@ package body Ada.Calendar.Formatting is
(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;
-----------
......@@ -400,19 +335,17 @@ package body Ada.Calendar.Formatting is
(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;
------------
......@@ -420,19 +353,17 @@ package body Ada.Calendar.Formatting is
------------
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;
----------------
......@@ -456,9 +387,9 @@ package body Ada.Calendar.Formatting is
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;
......@@ -489,10 +420,20 @@ package body Ada.Calendar.Formatting is
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;
-----------
......@@ -508,16 +449,25 @@ package body Ada.Calendar.Formatting is
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;
-----------
......@@ -535,11 +485,27 @@ package body Ada.Calendar.Formatting is
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;
-----------
......@@ -558,139 +524,26 @@ package body Ada.Calendar.Formatting is
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;
----------------
......@@ -698,20 +551,17 @@ package body Ada.Calendar.Formatting is
----------------
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;
-------------
......@@ -726,79 +576,56 @@ package body Ada.Calendar.Formatting is
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;
-------------
......@@ -816,23 +643,11 @@ package body Ada.Calendar.Formatting is
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
......@@ -846,99 +661,13 @@ package body Ada.Calendar.Formatting is
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;
-----------
......@@ -1117,19 +846,18 @@ package body Ada.Calendar.Formatting is
(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;
gcc/ada/a-calfor.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
......@@ -35,6 +35,10 @@
-- --
------------------------------------------------------------------------------
-- 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
......@@ -84,6 +88,12 @@ 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;
......@@ -91,6 +101,9 @@ package Ada.Calendar.Formatting is
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;
......@@ -102,6 +115,9 @@ package Ada.Calendar.Formatting is
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;
......@@ -113,6 +129,14 @@ package Ada.Calendar.Formatting is
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;
......@@ -121,6 +145,14 @@ package Ada.Calendar.Formatting is
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;
......@@ -133,6 +165,14 @@ package Ada.Calendar.Formatting is
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;
......@@ -142,6 +182,14 @@ package Ada.Calendar.Formatting is
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
......@@ -149,15 +197,39 @@ package Ada.Calendar.Formatting is
(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;
gcc/ada/a-catizo.adb
......@@ -33,35 +33,39 @@
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;
gcc/ada/a-catizo.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
......@@ -35,6 +35,9 @@
-- --
------------------------------------------------------------------------------
-- 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
......@@ -44,5 +47,9 @@ package Ada.Calendar.Time_Zones is
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;
gcc/ada/a-direct.adb
......@@ -31,10 +31,11 @@
-- --
------------------------------------------------------------------------------
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;
......@@ -46,13 +47,6 @@ with System;
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;
......@@ -724,7 +718,7 @@ package body Ada.Directories is
-- 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;
......@@ -732,8 +726,7 @@ package body Ada.Directories is
Hour : Hour_Type;
Minute : Minute_Type;
Second : Second_Type;
Result : Ada.Calendar.Time;
Result : Time;
begin
-- First, the invalid cases
......@@ -744,26 +737,31 @@ package body Ada.Directories is
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;
......
gcc/ada/sysdep.c
......@@ -687,7 +687,7 @@ get_gmtoff (void)
/* 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;
......@@ -755,8 +755,9 @@ __gnat_localtime_tzoff (const time_t *, struct tm *, long *);
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;
}
......@@ -779,17 +780,60 @@ __gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
/* 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;
}
......@@ -797,3 +841,59 @@ __gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
#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__ */
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment