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 2842 additions and 1320 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;
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);
Op_Days : Long_Integer;
Op_Leaps : Integer;
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;
function "-" (Left, Right : Time) return Day_Count;
-- 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 : 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;
package body Ada.Calendar is
with Ada.Unchecked_Conversion;
------------------------------
-- Use of Pragma Unsuppress --
------------------------------
package body Ada.Calendar is
-- 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.
--------------------------
-- Implementation Notes --
--------------------------
------------------------
-- Local Declarations --
------------------------
-- Variables of type Ada.Calendar.Time have suffix _S or _M to denote
-- units of seconds or milis.
Ada_Year_Min : constant := 1901;
Ada_Year_Max : constant := 2099;
-----------------------
-- Local Subprograms --
-----------------------
-- Some basic constants used throughout
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.
function To_Relative_Time (D : Duration) return Time is
begin
return Time (Long_Integer'Integer_Value (D) / 100);
end To_Relative_Time;
---------------------
-- Local Constants --
---------------------
After_Last_Leap : constant Time := Time'Last;
N_Leap_Seconds : constant Natural := 23;
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;
......@@ -95,8 +139,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 =>
......@@ -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,56 +416,391 @@ package body Ada.Calendar is
Day : out Day_Number;
Seconds : out Day_Duration)
is
procedure Numtim (
Status : out Unsigned_Longword;
H : Integer;
M : Integer;
Se : Integer;
Ss : Duration;
Le : Boolean;
begin
Formatting_Operations.Split
(Date, Year, Month, Day, Seconds, H, M, Se, Ss, Le, 0);
-- 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;
end Split;
-------------
-- Time_Of --
-------------
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.
H : constant Integer := 1;
M : constant Integer := 1;
Se : constant Integer := 1;
Ss : constant Duration := 0.1;
begin
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;
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;
-----------------
-- To_Duration --
-----------------
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;
----------------------
-- To_Relative_Time --
----------------------
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
Y : Year_Number;
M : Month_Number;
D : Day_Number;
S : Day_Duration;
begin
Split (Date, Y, M, D, S);
return Y;
end Year;
-- The following packages assume that Time is a Long_Integer, the units
-- are 100 nanoseconds and the starting point in the VMS Epoch.
---------------------------
-- Arithmetic_Operations --
---------------------------
package body Arithmetic_Operations is
---------
-- Add --
---------
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
-- 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",
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;
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
Numtim (Status, Timbuf, Date_Secs);
Modified_Date_M := Date;
if Status mod 2 /= 1
or else Timbuf (1) not in Ada_Year_Min .. Ada_Year_Max
-- 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;
Seconds := Day_Duration (Timbuf (6)
+ 60 * (Timbuf (5) + 60 * Timbuf (4)))
+ Duration (Subsecs) / 10_000_000.0;
-- Step 3: Sub second processing
Day := Integer (Timbuf (3));
Month := Integer (Timbuf (2));
Year := Integer (Timbuf (1));
end Split;
Sub_Sec := Duration (Modified_Date_M mod Mili) / Mili_F;
-----------------------
-- Split_With_Offset --
-----------------------
-- Drop the sub seconds
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;
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));
Day_Secs := Day_Duration (Hour * 3_600) +
Day_Duration (Minute * 60) +
Day_Duration (Second) +
Sub_Sec;
end Split;
-------------
-- Time_Of --
......@@ -280,137 +810,261 @@ package body Ada.Calendar is
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0)
return Time
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;
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",
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;
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;
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
-- 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
raise Constraint_Error;
Result_M := Result_M + Milis_In_Day;
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.
-- 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 Seconds > 0.0 then
Int_Secs := Integer (Seconds - 0.5);
if Time_Zone < 0 then
Result_M := Result_M + Abs_Time_Zone;
else
Int_Secs := Integer (Seconds);
Result_M := Result_M - Abs_Time_Zone;
end if;
end if;
Subsecs := Seconds - Day_Duration (Int_Secs);
-- Step 6: Leap seconds processing
-- Cvt_Vectim barfs on the largest Day_Duration, so trick it by
-- setting it to zero and then adding the difference after conversion.
Cumulative_Leap_Seconds
(Ada_Low, Result_M, Elapsed_Leaps, Next_Leap_M);
if Int_Secs = 86_400 then
Int_Secs := 0;
Day_Hack := True;
end if;
Result_M := Result_M + Time (Elapsed_Leaps) * Mili;
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);
-- An Ada 2005 caller requesting an explicit leap second or an Ada
-- 95 caller accounting for an invisible leap second.
Cvt_Vectim (Status, Timbuf, Date);
Rounded_Result_M := Result_M - (Result_M mod Mili);
if Status mod 2 /= 1 then
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;
if Day_Hack then
Date := Date + 10_000_000 * 86_400;
-- Bounds check
if Result_M < Ada_Low
or else Result_M >= Ada_High_And_Leaps
then
raise Time_Error;
end if;
Date := Date + Time (10_000_000.0 * Subsecs);
return Date;
return Result_M;
end Time_Of;
end Formatting_Operations;
----------
-- Year --
----------
---------------------------
-- Time_Zones_Operations --
---------------------------
function Year (Date : Time) return Year_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
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
Split (Date, DY, DM, DD, DS);
return DY;
end Year;
-- 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.
-------------------
-- Leap_Sec_Ops --
-------------------
return get_gmtoff;
end UTC_Time_Offset;
end Time_Zones_Operations;
-- The package that is used by the Ada 2005 children of Ada.Calendar:
-- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
-- Start of elaboration code for Ada.Calendar
package body Leap_Sec_Ops is
begin
-- Population of the leap seconds table
--------------------------
-- Cumulative_Leap_Secs --
--------------------------
declare
type Leap_Second_Date is record
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
end record;
procedure Cumulative_Leap_Secs
(Start_Date : Time;
End_Date : Time;
Leaps_Between : out Duration;
Next_Leap_Sec : out Time)
is
begin
raise Unimplemented;
end Cumulative_Leap_Secs;
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));
----------------------
-- All_Leap_Seconds --
----------------------
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;
function All_Leap_Seconds return Duration is
begin
raise Unimplemented;
return 0.0;
end All_Leap_Seconds;
for Index in 1 .. N_Leap_Seconds loop
Leap := Leap_Second_Dates (Index);
-- Start of processing in package Leap_Sec_Ops
-- 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.
begin
null;
end Leap_Sec_Ops;
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
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;
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");
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,121 +31,175 @@
-- --
------------------------------------------------------------------------------
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.
--------------------------
-- Implementation Notes --
--------------------------
------------------------
-- Local Declarations --
------------------------
-- 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).
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.
-----------------------
-- Local Subprograms --
-----------------------
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;
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;
type tm_Pointer is access all tm;
Cumulative_Days_Before_Month :
constant array (Month_Number) of Natural :=
(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
subtype time_t is long;
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.
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 "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
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.
begin
if Right = 0.0 then
return Left;
-- 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.
elsif Right < 0.0 then
-- 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.
-- 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.
Unix_Year_Min : constant := 1970;
Unix_Year_Max : constant := 2026;
if Right = Duration'First then
return Left - abs (Right + 1.0) - 1.0;
else
return Left - abs (Right);
end if;
Ada_Year_Min : constant := 1901;
Ada_Year_Max : constant := 2099;
else
declare
-- The input time value has been normalized to GMT
-- Some basic constants used throughout
Result : constant Time := Left + To_Abs_Time (Right);
Days_In_Month : constant array (Month_Number) of Day_Number :=
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
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).
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);
if Result >= Ada_High_And_Leaps then
raise Time_Error;
end if;
---------
-- "+" --
---------
return Result;
end;
end if;
function "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
begin
return (Left + Time (Right));
exception
when Constraint_Error =>
raise Time_Error;
end "+";
function "+" (Left : Duration; Right : Time) return Time is
pragma Unsuppress (Overflow_Check);
begin
return (Time (Left) + Right);
exception
when Constraint_Error =>
raise Time_Error;
return Right + Left;
end "+";
---------
......@@ -154,8 +208,40 @@ package body Ada.Calendar is
function "-" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
begin
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
return Left - Time (Right);
-- 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.
-- We first start by obtaining the current local time zone offset
-- using Ada.Calendar.Clock, then building an intermediate time
-- value using that offset.
Year_Val := 0;
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);
while D < 0.0 loop
D := D + Seconds_In_56_YearsD;
Year_Val := Year_Val - 56;
end loop;
-- This is the true local time zone offset of the input time values
while D >= Seconds_In_56_YearsD loop
D := D - Seconds_In_56_YearsD;
Year_Val := Year_Val + 56;
end loop;
Offset := Time_Zones_Operations.UTC_Time_Offset (Mid_Result) / 60;
-- 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).
-- 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.
-- 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
if Offset = Mid_Offset then
return Mid_Result;
-- 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.
else
declare
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
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 Time_Of;
function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
function To_Duration is new Unchecked_Conversion (D_Int, Duration);
---------------------
-- To_Abs_Duration --
---------------------
D_As_Int : constant D_Int := To_D_Int (D);
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
function To_Abs_Duration (T : Time) return Duration is
pragma Unsuppress (Overflow_Check);
function To_Duration is new Ada.Unchecked_Conversion (Time, Duration);
begin
Adjusted_Seconds := time_t (D_As_Int / Small_Div);
Frac_Sec := To_Duration (D_As_Int rem Small_Div);
end;
return To_Duration (T);
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
exception
when Constraint_Error =>
raise Time_Error;
else
Year := Year_Val;
end if;
end Split_With_Offset;
-------------
-- Time_Of --
-------------
end To_Abs_Duration;
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_Time --
-----------------
Year_Val : Integer := Year;
Duration_Adjust : Duration := 0.0;
function To_Abs_Time (D : Duration) return Time is
pragma Unsuppress (Overflow_Check);
function To_Time is new Ada.Unchecked_Conversion (Duration, Time);
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).
-- This operation assumes that D is positive
if not Year 'Valid
or else not Month 'Valid
or else not Day 'Valid
or else not Seconds'Valid
then
if D < 0.0 then
raise Constraint_Error;
end if;
-- 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).
return To_Time (D);
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;
end To_Abs_Time;
----------
-- Year --
----------
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;
function Year (Date : Time) return Year_Number is
Y : Year_Number;
M : Month_Number;
D : Day_Number;
S : Day_Duration;
begin
Split (Date, Y, M, D, S);
return Y;
end Year;
-- 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.
-- 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).
while Year_Val < Unix_Year_Min loop
Year_Val := Year_Val + 56;
Duration_Adjust := Duration_Adjust - Seconds_In_56_YearsD;
end loop;
---------------------------
-- Arithmetic_Operations --
---------------------------
while Year_Val >= Unix_Year_Max loop
Year_Val := Year_Val - 56;
Duration_Adjust := Duration_Adjust + Seconds_In_56_YearsD;
end loop;
package body Arithmetic_Operations is
TM_Val.tm_year := Year_Val - 1900;
---------
-- Add --
---------
-- 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.
function Add (Date : Time; Days : Long_Integer) return Time is
begin
if Days = 0 then
return Date;
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);
end if;
elsif Days < 0 then
return Subtract (Date, abs (Days));
-- Since we do not have information on daylight savings, rely on the
-- default information.
else
declare
Result : constant Time := Date + Time (Days) * Nanos_In_Day;
TM_Val.tm_isdst := -1;
Result_Secs := mktime (TM_Val'Unchecked_Access);
begin
-- The result excedes the upper bound of Ada time
-- 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.
if Result > Ada_High_And_Leaps then
raise Time_Error;
end if;
return
Time (Duration (Result_Secs) +
Duration_Adjust +
(Seconds - Duration (Int_Secs)));
end Time_Of;
return Result;
end;
end if;
----------
-- Year --
----------
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
Diff_N : Time;
Diff_S : Time;
Earlier : Time;
Elapsed_Leaps : Natural;
Later : Time;
Negate : Boolean := False;
Next_Leap : Time;
Sub_Seconds : Duration;
function Year (Date : Time) return Year_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DY;
end Year;
-- Both input time values are assumed to be in GMT
-------------------
-- Leap_Sec_Ops --
-------------------
if Left >= Right then
Later := Left;
Earlier := Right;
else
Later := Right;
Earlier := Left;
Negate := True;
end if;
-- The package that is used by the Ada 2005 children of Ada.Calendar:
-- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
-- First process the leap seconds
package body Leap_Sec_Ops is
Cumulative_Leap_Seconds (Earlier, Later, Elapsed_Leaps, Next_Leap);
-- 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.
if Later >= Next_Leap then
Elapsed_Leaps := Elapsed_Leaps + 1;
end if;
-- 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).
Diff_N := Later - Earlier - Time (Elapsed_Leaps) * Nano;
N_Leap_Secs : constant := 23;
-- Sub second processing
type Leap_Second_Date is record
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
end record;
Sub_Seconds := Duration (Diff_N mod Nano) / Nano_F;
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));
-- Convert to seconds. Note that his action eliminates the sub
-- seconds automatically.
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;
Diff_S := Diff_N / Nano;
--------------------------
-- Cumulative_Leap_Secs --
--------------------------
Days := Long_Integer (Diff_S / Secs_In_Day);
Seconds := Duration (Diff_S mod Secs_In_Day) + Sub_Seconds;
Leap_Seconds := Integer (Elapsed_Leaps);
procedure Cumulative_Leap_Secs
(Start_Date : Time;
End_Date : Time;
Leaps_Between : out Duration;
Next_Leap_Sec : out Time)
is
End_T : Time;
K : Positive;
Leap_Index : Positive;
Start_Tmp : Time;
Start_T : Time;
if Negate then
Days := -Days;
Seconds := -Seconds;
Leap_Seconds := -Leap_Seconds;
end if;
end Difference;
--------------
-- Subtract --
--------------
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
function Subtract (Date : Time; Days : Long_Integer) return Time is
begin
if Days = 0 then
return Date;
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
D_As_Int : D_Int;
elsif Days < 0 then
return Add (Date, abs (Days));
function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
else
declare
Days_T : constant Time := Time (Days) * Nanos_In_Day;
Result : Time;
begin
Next_Leap_Sec := After_Last_Leap;
-- Subtracting a larger number of days from a smaller time
-- value will cause wrap around since time is a modular type.
-- We want to throw away the fractional part of seconds. Before
-- proceding with this operation, make sure our working values
-- are non-negative.
if Date < Days_T then
raise Time_Error;
end if;
if End_Date < 0.0 then
Leaps_Between := 0.0;
return;
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;
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;
begin
Modified_Time := Ada_Time;
Rounded_Time := Modified_Time - (Modified_Time mod Nano);
-- 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;
if Start_Date < 0.0 then
Start_Tmp := Time (0.0);
-- 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
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;
-- 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;
-- Step 2: Time zone processing. This action converts the input date
-- from GMT to the requested time zone.
if Time_Zone /= 0 then
Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Nano;
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.
Modified_Date_N := Modified_Date_N - Abs_Time_Zone;
else
Start_Tmp := Start_Date;
Modified_Date_N := Modified_Date_N + Abs_Time_Zone;
end if;
end if;
if Start_Date <= Leap_Second_Times (N_Leap_Secs) then
-- After the elapsed leap seconds have been removed and the date
-- has been normalized, it should fall withing the soft bounds of
-- Ada time.
-- 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.
if Modified_Date_N < Ada_Low
or else Modified_Date_N > Ada_High
then
raise Time_Error;
end if;
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);
-- Before any additional arithmetic is performed we must remove the
-- lower buffer period since it will be accounted as few additional
-- days.
Leap_Index := 1;
loop
exit when Leap_Second_Times (Leap_Index) >= Start_T;
Leap_Index := Leap_Index + 1;
end loop;
Modified_Date_N := Modified_Date_N - Buffer_N;
K := Leap_Index;
loop
exit when K > N_Leap_Secs or else
Leap_Second_Times (K) >= End_T;
K := K + 1;
-- 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;
-- 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
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;
if K <= N_Leap_Secs then
Next_Leap_Sec := Leap_Second_Times (K);
-- 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;
Leaps_Between := Duration (K - Leap_Index);
-- 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;
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
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
Leaps_Between := Duration (0.0);
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;
end Cumulative_Leap_Secs;
----------------------
-- All_Leap_Seconds --
----------------------
-- 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.
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;
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
-- Start of processing in package Leap_Sec_Ops
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;
-- 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;
Is_Leap_Year : Boolean;
Leap : Leap_Second_Date;
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;
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;
Is_Leap_Year := False;
if Years = 1 then
Days := Days + 365;
elsif Years = 2 then
Is_Leap_Year := True;
-- 1972 or multiple of 4 after
Days := Days + 365 * 2;
elsif Years = 3 then
Days := Days + 365 * 3 + 1;
Days := Days + 365 * 3;
end if;
Days := Days + Cumulative_Days_Before_Month
(Leap_Second_Dates (J).Month);
Days := Days + Cumulative_Days_Before_Month (Leap.Month);
if Is_Leap_Year
and then Leap_Second_Dates (J).Month > 2
if Is_Leap (Leap.Year)
and then Leap.Month > 2
then
Days := Days + 1;
end if;
Days := Days + Leap_Second_Dates (J).Day;
Leap_Second_Times (J) :=
Time (Days * Duration (86_400.0) + Duration (J - 1));
Days := Days + Leap.Day;
-- Add one to get to the leap second. Add J - 1 previous
-- leap seconds.
-- 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 Leap_Sec_Ops;
begin
System.OS_Primitives.Initialize;
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.
-- 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
function All_Leap_Seconds return Duration;
-- Returns the sum off all of the leap seoncds.
-- 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.
end Leap_Sec_Ops;
Buffer_D : constant Duration := 2.0 * Secs_In_Day;
Buffer_N : constant Time := 2 * Nanos_In_Day;
procedure Split_With_Offset
-- 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;
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");
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,7 +387,7 @@ package body Ada.Calendar.Formatting is
raise Constraint_Error;
end if;
return Day_Duration (Hour * 3600) +
return Day_Duration (Hour * 3_600) +
Day_Duration (Minute * 60) +
Day_Duration (Second) +
Sub_Second;
......@@ -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);
Seconds := Seconds_Of (Hour, Minute, Second, Sub_Second);
-- 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;
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,38 +576,35 @@ 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)
or else (Is_Leap (Year)
and then Month = 2)
then
Adj_Day := Day + 1;
else
......@@ -770,35 +617,15 @@ package body Ada.Calendar.Formatting is
Adj_Year := Year + 1;
end if;
end if;
return Time_Of (Adj_Year, Adj_Month, Adj_Day, Hour, Minute,
Sec_Num, Sub_Sec, Leap_Second, Time_Zone);
end;
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,27 +737,32 @@ 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 := Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0);
end if;
Result :=
Duration_To_Time (Duration (OS_Time_To_Long_Integer (Date)));
return Result;
end if;
end if;
end Modification_Time;
function 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)
/* 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;
/* Lynx, VXWorks */
#elif defined (__Lynx__) || defined (__vxworks)
*off = __gnat_invalid_tzoff;
/* 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");
/* Darwin, Free BSD, Linux, Tru64 */
#else
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, 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