Skip to content

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

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

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

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

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

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

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

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

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

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

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

From-SVN: r123543
parent 3d3bf932
Showing with 2933 additions and 1411 deletions
gcc/ada/a-calari.adb
...@@ -31,26 +31,29 @@ ...@@ -31,26 +31,29 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Unchecked_Conversion;
package body Ada.Calendar.Arithmetic is 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 function "+" (Left : Time; Right : Day_Count) return Time is
R : constant Long_Integer := Long_Integer (Right);
begin begin
return Left + Integer (Right) * Day_Duration; return Arithmetic_Operations.Add (Left, R);
end "+"; end "+";
function "+" (Left : Day_Count; Right : Time) return Time is function "+" (Left : Day_Count; Right : Time) return Time is
L : constant Long_Integer := Long_Integer (Left);
begin begin
return Integer (Left) * Day_Duration + Right; return Arithmetic_Operations.Add (Right, L);
end "+"; end "+";
--------- ---------
...@@ -58,18 +61,19 @@ package body Ada.Calendar.Arithmetic is ...@@ -58,18 +61,19 @@ package body Ada.Calendar.Arithmetic is
--------- ---------
function "-" (Left : Time; Right : Day_Count) return Time is function "-" (Left : Time; Right : Day_Count) return Time is
R : constant Long_Integer := Long_Integer (Right);
begin begin
return Left - Integer (Right) * Day_Duration; return Arithmetic_Operations.Subtract (Left, R);
end "-"; end "-";
function "-" (Left, Right : Time) return Day_Count is function "-" (Left, Right : Time) return Day_Count is
Days : Day_Count; Days : Long_Integer;
Seconds : Duration; Seconds : Duration;
Leap_Seconds : Leap_Seconds_Count; Leap_Seconds : Integer;
begin begin
Difference (Left, Right, Days, Seconds, Leap_Seconds); Arithmetic_Operations.Difference
return Days; (Left, Right, Days, Seconds, Leap_Seconds);
return Day_Count (Days);
end "-"; end "-";
---------------- ----------------
...@@ -77,66 +81,19 @@ package body Ada.Calendar.Arithmetic is ...@@ -77,66 +81,19 @@ package body Ada.Calendar.Arithmetic is
---------------- ----------------
procedure Difference procedure Difference
(Left, Right : Time; (Left : Time;
Right : Time;
Days : out Day_Count; Days : out Day_Count;
Seconds : out Duration; Seconds : out Duration;
Leap_Seconds : out Leap_Seconds_Count) Leap_Seconds : out Leap_Seconds_Count)
is is
Diff : Duration; Op_Days : Long_Integer;
Earlier : Time; Op_Leaps : Integer;
Later : Time;
Leaps_Dur : Duration;
Negate : Boolean;
Next_Leap : Time;
Secs_Diff : Long_Integer;
Sub_Seconds : Duration;
begin begin
if Left >= Right then Arithmetic_Operations.Difference
Later := Left; (Left, Right, Op_Days, Seconds, Op_Leaps);
Earlier := Right; Days := Day_Count (Op_Days);
Negate := False; Leap_Seconds := Leap_Seconds_Count (Op_Leaps);
else
Later := Right;
Earlier := Left;
Negate := True;
end if;
Diff := Later - Earlier;
Cumulative_Leap_Secs (Earlier, Later, Leaps_Dur, Next_Leap);
if Later >= Next_Leap then
Leaps_Dur := Leaps_Dur + 1.0;
end if;
Diff := Diff - Leaps_Dur;
declare
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
D_As_Int : D_Int;
function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
function To_Duration is new Unchecked_Conversion (D_Int, Duration);
begin
D_As_Int := To_D_As_Int (Diff);
Secs_Diff := Long_Integer (D_As_Int / Small_Div);
Sub_Seconds := To_Duration (D_As_Int rem Small_Div);
end;
Days := Day_Count (Secs_Diff / 86_400);
Seconds := Duration (Secs_Diff mod 86_400) + Sub_Seconds;
Leap_Seconds := Leap_Seconds_Count (Leaps_Dur);
if Negate then
Days := -Days;
Seconds := -Seconds;
Leap_Seconds := -Leap_Seconds;
end if;
end Difference; end Difference;
end Ada.Calendar.Arithmetic; end Ada.Calendar.Arithmetic;
gcc/ada/a-calari.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -35,26 +35,51 @@ ...@@ -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 package Ada.Calendar.Arithmetic is
-- Arithmetic on days: -- Arithmetic on days:
-- Rough estimate on the number of days over the range of Ada time
type Day_Count is range type Day_Count is range
-(366 * (1 + Year_Number'Last - Year_Number'First)) -(366 * (1 + Year_Number'Last - Year_Number'First))
.. ..
+(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; subtype Leap_Seconds_Count is Integer range -2047 .. 2047;
procedure Difference procedure Difference
(Left, Right : Time; (Left : Time;
Right : Time;
Days : out Day_Count; Days : out Day_Count;
Seconds : out Duration; Seconds : out Duration;
Leap_Seconds : out Leap_Seconds_Count); Leap_Seconds : out Leap_Seconds_Count);
-- Returns the difference between Left and Right. Days is the number of
-- days of difference, Seconds is the remainder seconds of difference
-- excluding leap seconds, and Leap_Seconds is the number of leap seconds.
-- If Left < Right, then Seconds <= 0.0, Days <= 0, and Leap_Seconds <= 0,
-- otherwise all values are nonnegative. The absolute value of Seconds is
-- always less than 86_400.0. For the returned values, if Days = 0, then
-- Seconds + Duration (Leap_Seconds) = Calendar."-" (Left, Right)
function "+" (Left : Time; Right : Day_Count) return Time;
function "+" (Left : Day_Count; Right : Time) return Time;
-- Adds a number of days to a time value. Time_Error is raised if the
-- result is not representable as a value of type Time.
function "-" (Left : Time; Right : Day_Count) return Time;
-- Subtracts a number of days from a time value. Time_Error is raised if
-- the result is not representable as a value of type Time.
function "+" (Left : Time; Right : Day_Count) return Time; function "-" (Left : Time; Right : Time) return Day_Count;
function "+" (Left : Day_Count; Right : Time) return Time; -- Subtracts two time values, and returns the number of days between them.
function "-" (Left : Time; Right : Day_Count) return Time; -- This is the same value that Difference would return in Days.
function "-" (Left, Right : Time) return Day_Count;
end Ada.Calendar.Arithmetic; end Ada.Calendar.Arithmetic;
gcc/ada/a-caldel.adb
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1991-1994, Florida State University -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -54,12 +54,12 @@ package body Ada.Calendar.Delays is ...@@ -54,12 +54,12 @@ package body Ada.Calendar.Delays is
use System.Traces; use System.Traces;
-- Earlier, the following operations were implemented using -- Earlier, System.Time_Opeations was used to implement the following
-- System.Time_Operations. The idea was to avoid sucking in the tasking -- operations. The idea was to avoid sucking in the tasking packages. This
-- packages. This did not work. Logically, we can't have it both ways. -- did not work. Logically, we can't have it both ways. There is no way to
-- There is no way to implement time delays that will have correct task -- implement time delays that will have correct task semantics without
-- semantics without reference to the tasking run-time system. -- reference to the tasking run-time system. To achieve this goal, we now
-- To achieve this goal, we now use soft links. -- use soft links.
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
...@@ -120,18 +120,23 @@ package body Ada.Calendar.Delays is ...@@ -120,18 +120,23 @@ package body Ada.Calendar.Delays is
function To_Duration (T : Time) return Duration is function To_Duration (T : Time) return Duration is
begin 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; end To_Duration;
begin begin
-- Set up the Timed_Delay soft link to the non tasking version -- Set up the Timed_Delay soft link to the non tasking version if it has
-- if it has not been already set. -- not been already set.
-- If tasking is present, Timed_Delay has already set this soft -- If tasking is present, Timed_Delay has already set this soft link, or
-- link, or this will be overriden during the elaboration of -- this will be overriden during the elaboration of
-- System.Tasking.Initialization -- System.Tasking.Initialization
if SSL.Timed_Delay = null then if SSL.Timed_Delay = null then
SSL.Timed_Delay := Timed_Delay_NT'Access; SSL.Timed_Delay := Timed_Delay_NT'Access;
end if; end if;
end Ada.Calendar.Delays; end Ada.Calendar.Delays;
gcc/ada/a-calend-vms.adb
...@@ -35,35 +35,70 @@ ...@@ -35,35 +35,70 @@
with System.Aux_DEC; use System.Aux_DEC; with System.Aux_DEC; use System.Aux_DEC;
with Ada.Unchecked_Conversion;
package body Ada.Calendar is package body Ada.Calendar is
------------------------------ --------------------------
-- Use of Pragma Unsuppress -- -- Implementation Notes --
------------------------------ --------------------------
-- This implementation of Calendar takes advantage of the permission in -- Variables of type Ada.Calendar.Time have suffix _S or _M to denote
-- Ada 95 of using arithmetic overflow checks to check for out of bounds -- units of seconds or milis.
-- time values. This means that we must catch the constraint error that
-- results from arithmetic overflow, so we use pragma Unsuppress to make
-- sure that overflow is enabled, using software overflow checking if
-- necessary. That way, compiling Calendar with options to suppress this
-- checking will not affect its correctness.
------------------------ -----------------------
-- Local Declarations -- -- Local Subprograms --
------------------------ -----------------------
Ada_Year_Min : constant := 1901; function All_Leap_Seconds return Natural;
Ada_Year_Max : constant := 2099; -- Return the number of all leap seconds allocated so far
procedure Cumulative_Leap_Seconds
(Start_Date : Time;
End_Date : Time;
Elapsed_Leaps : out Natural;
Next_Leap_Sec : out Time);
-- Elapsed_Leaps is the sum of the leap seconds that have occured on or
-- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
-- represents the next leap second occurence on or after End_Date. If there
-- are no leaps seconds after End_Date, After_Last_Leap is returned.
-- After_Last_Leap can be used as End_Date to count all the leap seconds
-- that have occured on or after Start_Date.
--
-- Note: Any sub seconds of Start_Date and End_Date are discarded before
-- the calculations are done. For instance: if 113 seconds is a leap
-- second (it isn't) and 113.5 is input as an End_Date, the leap second
-- at 113 will not be counted in Leaps_Between, but it will be returned
-- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
-- a leap second, the comparison should be:
--
-- End_Date >= Next_Leap_Sec;
--
-- After_Last_Leap is designed so that this comparison works without
-- having to first check if Next_Leap_Sec is a valid leap second.
function To_Duration (T : Time) return Duration;
function To_Relative_Time (D : Duration) return Time;
-- It is important to note that duration's fractional part denotes nano
-- seconds while the units of Time are 100 nanoseconds. If a regular
-- Unchecked_Conversion was employed, the resulting values would be off
-- by 100.
-- Some basic constants used throughout ---------------------
-- Local Constants --
---------------------
function To_Relative_Time (D : Duration) return Time; After_Last_Leap : constant Time := Time'Last;
N_Leap_Seconds : constant Natural := 23;
function To_Relative_Time (D : Duration) return Time is Cumulative_Days_Before_Month :
begin constant array (Month_Number) of Natural :=
return Time (Long_Integer'Integer_Value (D) / 100); (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
end To_Relative_Time;
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 ...@@ -71,9 +106,19 @@ package body Ada.Calendar is
function "+" (Left : Time; Right : Duration) return Time is function "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check); 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 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 exception
when Constraint_Error => when Constraint_Error =>
raise Time_Error; raise Time_Error;
...@@ -82,8 +127,7 @@ package body Ada.Calendar is ...@@ -82,8 +127,7 @@ package body Ada.Calendar is
function "+" (Left : Duration; Right : Time) return Time is function "+" (Left : Duration; Right : Time) return Time is
pragma Unsuppress (Overflow_Check); pragma Unsuppress (Overflow_Check);
begin begin
return (To_Relative_Time (Left) + Right); return Right + Left;
exception exception
when Constraint_Error => when Constraint_Error =>
raise Time_Error; raise Time_Error;
...@@ -93,10 +137,21 @@ package body Ada.Calendar is ...@@ -93,10 +137,21 @@ package body Ada.Calendar is
-- "-" -- -- "-" --
--------- ---------
function "-" (Left : Time; Right : Duration) return Time is function "-" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check); 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 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 exception
when Constraint_Error => when Constraint_Error =>
...@@ -105,9 +160,19 @@ package body Ada.Calendar is ...@@ -105,9 +160,19 @@ package body Ada.Calendar is
function "-" (Left : Time; Right : Time) return Duration is function "-" (Left : Time; Right : Time) return Duration is
pragma Unsuppress (Overflow_Check); 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 begin
return Duration'Fixed_Value if Diff < Dur_Low
((Long_Integer (Left) - Long_Integer (Right)) * 100); or else Diff > Dur_High
then
raise Time_Error;
end if;
return To_Duration (Diff);
exception exception
when Constraint_Error => when Constraint_Error =>
...@@ -150,49 +215,180 @@ package body Ada.Calendar is ...@@ -150,49 +215,180 @@ package body Ada.Calendar is
return Long_Integer (Left) >= Long_Integer (Right); return Long_Integer (Left) >= Long_Integer (Right);
end ">="; end ">=";
----------------------
-- All_Leap_Seconds --
----------------------
function All_Leap_Seconds return Natural is
begin
return N_Leap_Seconds;
end All_Leap_Seconds;
----------- -----------
-- Clock -- -- 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 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 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; 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 -- -- Day --
--------- ---------
function Day (Date : Time) return Day_Number is function Day (Date : Time) return Day_Number is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DD; return D;
end Day; 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 -- -- Month --
----------- -----------
function Month (Date : Time) return Month_Number is function Month (Date : Time) return Month_Number is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DM; return M;
end Month; end Month;
------------- -------------
...@@ -200,14 +396,13 @@ package body Ada.Calendar is ...@@ -200,14 +396,13 @@ package body Ada.Calendar is
------------- -------------
function Seconds (Date : Time) return Day_Duration is function Seconds (Date : Time) return Day_Duration is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DS; return S;
end Seconds; end Seconds;
----------- -----------
...@@ -221,57 +416,27 @@ package body Ada.Calendar is ...@@ -221,57 +416,27 @@ package body Ada.Calendar is
Day : out Day_Number; Day : out Day_Number;
Seconds : out Day_Duration) Seconds : out Day_Duration)
is is
procedure Numtim ( H : Integer;
Status : out Unsigned_Longword; M : Integer;
Timbuf : out Unsigned_Word_Array; Se : Integer;
Timadr : Time); Ss : Duration;
Le : Boolean;
pragma Interface (External, Numtim);
pragma Import_Valued_Procedure (Numtim, "SYS$NUMTIM",
(Unsigned_Longword, Unsigned_Word_Array, Time),
(Value, Reference, Reference));
Status : Unsigned_Longword;
Timbuf : Unsigned_Word_Array (1 .. 7);
Subsecs : constant Time := Date mod 10_000_000;
Date_Secs : constant Time := Date - Subsecs;
begin begin
Numtim (Status, Timbuf, Date_Secs); Formatting_Operations.Split
(Date, Year, Month, Day, Seconds, H, M, Se, Ss, Le, 0);
if Status mod 2 /= 1 -- Validity checks
or else Timbuf (1) not in Ada_Year_Min .. Ada_Year_Max
if not Year'Valid
or else not Month'Valid
or else not Day'Valid
or else not Seconds'Valid
then then
raise Time_Error; raise Time_Error;
end if; end if;
Seconds := Day_Duration (Timbuf (6)
+ 60 * (Timbuf (5) + 60 * Timbuf (4)))
+ Duration (Subsecs) / 10_000_000.0;
Day := Integer (Timbuf (3));
Month := Integer (Timbuf (2));
Year := Integer (Timbuf (1));
end Split; end Split;
-----------------------
-- Split_With_Offset --
-----------------------
procedure Split_With_Offset
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration;
Offset : out Long_Integer)
is
begin
raise Unimplemented;
end Split_With_Offset;
------------- -------------
-- Time_Of -- -- Time_Of --
------------- -------------
...@@ -280,137 +445,626 @@ package body Ada.Calendar is ...@@ -280,137 +445,626 @@ package body Ada.Calendar is
(Year : Year_Number; (Year : Year_Number;
Month : Month_Number; Month : Month_Number;
Day : Day_Number; Day : Day_Number;
Seconds : Day_Duration := 0.0) Seconds : Day_Duration := 0.0) return Time
return Time
is is
-- The values in the following constants are irrelevant, they are just
-- placeholders; the choice of constructing a Day_Duration value is
-- controlled by the Use_Day_Secs flag.
procedure Cvt_Vectim ( H : constant Integer := 1;
Status : out Unsigned_Longword; M : constant Integer := 1;
Input_Time : Unsigned_Word_Array; Se : constant Integer := 1;
Resultant_Time : out Time); Ss : constant Duration := 0.1;
pragma Interface (External, Cvt_Vectim);
pragma Import_Valued_Procedure (Cvt_Vectim, "LIB$CVT_VECTIM",
(Unsigned_Longword, Unsigned_Word_Array, Time),
(Value, Reference, Reference));
Status : Unsigned_Longword;
Timbuf : Unsigned_Word_Array (1 .. 7);
Date : Time;
Int_Secs : Integer;
Day_Hack : Boolean := False;
Subsecs : Day_Duration;
begin begin
-- The following checks are redundant with respect to the constraint if not Year'Valid
-- error checks that should normally be made on parameters, but we or else not Month'Valid
-- decide to raise Constraint_Error in any case if bad values come or else not Day'Valid
-- 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 or else not Seconds'Valid
then then
raise Constraint_Error; raise Time_Error;
end if;
-- Truncate seconds value by subtracting 0.5 and rounding,
-- but be careful with 0.0 since that will give -1.0 unless
-- it is treated specially.
if Seconds > 0.0 then
Int_Secs := Integer (Seconds - 0.5);
else
Int_Secs := Integer (Seconds);
end if;
Subsecs := Seconds - Day_Duration (Int_Secs);
-- Cvt_Vectim barfs on the largest Day_Duration, so trick it by
-- setting it to zero and then adding the difference after conversion.
if Int_Secs = 86_400 then
Int_Secs := 0;
Day_Hack := True;
end if; end if;
Timbuf (7) := 0; return
Timbuf (6) := Unsigned_Word (Int_Secs mod 60); Formatting_Operations.Time_Of
Timbuf (5) := Unsigned_Word ((Int_Secs / 60) mod 60); (Year, Month, Day, Seconds, H, M, Se, Ss,
Timbuf (4) := Unsigned_Word (Int_Secs / 3600); Leap_Sec => False,
Timbuf (3) := Unsigned_Word (Day); Leap_Checks => False,
Timbuf (2) := Unsigned_Word (Month); Use_Day_Secs => True,
Timbuf (1) := Unsigned_Word (Year); Time_Zone => 0);
end Time_Of;
Cvt_Vectim (Status, Timbuf, Date); -----------------
-- To_Duration --
-----------------
if Status mod 2 /= 1 then function To_Duration (T : Time) return Duration is
raise Time_Error; function Time_To_Duration is
end if; new Ada.Unchecked_Conversion (Time, Duration);
begin
return Time_To_Duration (T * 100);
end To_Duration;
if Day_Hack then ----------------------
Date := Date + 10_000_000 * 86_400; -- To_Relative_Time --
end if; ----------------------
Date := Date + Time (10_000_000.0 * Subsecs); function To_Relative_Time (D : Duration) return Time is
return Date; function Duration_To_Time is
end Time_Of; new Ada.Unchecked_Conversion (Duration, Time);
begin
return Duration_To_Time (D / 100.0);
end To_Relative_Time;
---------- ----------
-- Year -- -- Year --
---------- ----------
function Year (Date : Time) return Year_Number is function Year (Date : Time) return Year_Number is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DY; return Y;
end Year; end Year;
------------------- -- The following packages assume that Time is a Long_Integer, the units
-- Leap_Sec_Ops -- -- are 100 nanoseconds and the starting point in the VMS Epoch.
-------------------
-- The package that is used by the Ada 2005 children of Ada.Calendar: ---------------------------
-- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting. -- Arithmetic_Operations --
---------------------------
package body Leap_Sec_Ops is package body Arithmetic_Operations is
-------------------------- ---------
-- Cumulative_Leap_Secs -- -- Add --
-------------------------- ---------
procedure Cumulative_Leap_Secs function Add (Date : Time; Days : Long_Integer) return Time is
(Start_Date : Time; Ada_High_And_Leaps : constant Time :=
End_Date : Time; Ada_High + Time (All_Leap_Seconds) * Mili;
Leaps_Between : out Duration; begin
Next_Leap_Sec : out Time) 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 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 begin
raise Unimplemented; -- This classification is necessary in order to avoid a Time_Error
end Cumulative_Leap_Secs; -- being raised by the arithmetic operators in Ada.Calendar.
if Left >= Right then
Later := Left;
Earlier := Right;
Negate := False;
else
Later := Right;
Earlier := Left;
Negate := True;
end if;
-- First process the leap seconds
Cumulative_Leap_Seconds (Earlier, Later, Elapsed_Leaps, Next_Leap);
if Later >= Next_Leap then
Elapsed_Leaps := Elapsed_Leaps + 1;
end if;
Diff_M := Later - Earlier - Time (Elapsed_Leaps) * Mili;
-- Sub second processing
Sub_Seconds := Duration (Diff_M mod Mili) / Mili_F;
-- Convert to seconds. Note that his action eliminates the sub
-- seconds automatically.
Diff_S := Diff_M / Mili;
Days := Long_Integer (Diff_S / Secs_In_Day);
Seconds := Duration (Diff_S mod Secs_In_Day) + Sub_Seconds;
Leap_Seconds := Integer (Elapsed_Leaps);
if Negate then
Days := -Days;
Seconds := -Seconds;
Leap_Seconds := -Leap_Seconds;
end if;
end Difference;
--------------
-- Subtract --
--------------
function Subtract (Date : Time; Days : Long_Integer) return Time is
begin
if Days = 0 then
return Date;
elsif Days < 0 then
return Add (Date, abs (Days));
else
declare
Days_T : constant Time := Time (Days) * Milis_In_Day;
Result : constant Time := Date - Days_T;
begin
-- Subtracting a larger number of days from a smaller time
-- value will cause wrap around since time is a modular type.
-- Also the result may be lower than the start of Ada time.
if Date < Days_T
or Result < Ada_Low
then
raise Time_Error;
end if;
return Date - Days_T;
end;
end if;
exception
when Constraint_Error =>
raise Time_Error;
end Subtract;
end Arithmetic_Operations;
---------------------------
-- Formatting_Operations --
---------------------------
package body Formatting_Operations is
-----------------
-- Day_Of_Week --
-----------------
function Day_Of_Week (Date : Time) return Integer is
Y : Year_Number;
M : Month_Number;
D : Day_Number;
S : Day_Duration;
Day_Count : Long_Integer;
Midday_Date_S : Time;
begin
Split (Date, Y, M, D, S);
-- Build a time value in the middle of the same day and convert the
-- time value to seconds.
Midday_Date_S := Time_Of (Y, M, D, 43_200.0) / Mili;
-- Count the number of days since the start of VMS time. 1858-11-17
-- was a Wednesday.
Day_Count := Long_Integer (Midday_Date_S / Secs_In_Day) + 2;
return Integer (Day_Count mod 7);
end Day_Of_Week;
-----------
-- Split --
-----------
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Day_Secs : out Day_Duration;
Hour : out Integer;
Minute : out Integer;
Second : out Integer;
Sub_Sec : out Duration;
Leap_Sec : out Boolean;
Time_Zone : Long_Integer)
is
procedure Numtim
(Status : out Unsigned_Longword;
Timbuf : out Unsigned_Word_Array;
Timadr : Time);
pragma Interface (External, Numtim);
pragma Import_Valued_Procedure
(Numtim, "SYS$NUMTIM",
(Unsigned_Longword, Unsigned_Word_Array, Time),
(Value, Reference, Reference));
Status : Unsigned_Longword;
Timbuf : Unsigned_Word_Array (1 .. 7);
Ada_Min_Year : constant := 1901;
Ada_Max_Year : constant := 2399;
Mili_F : constant Duration := 10_000_000.0;
Abs_Time_Zone : Time;
Elapsed_Leaps : Natural;
Modified_Date_M : Time;
Next_Leap_M : Time;
Rounded_Date_M : Time;
begin
Modified_Date_M := Date;
-- Step 1: Leap seconds processing
Cumulative_Leap_Seconds (Ada_Low, Date, Elapsed_Leaps, Next_Leap_M);
Rounded_Date_M := Modified_Date_M - (Modified_Date_M mod Mili);
Leap_Sec := Rounded_Date_M = Next_Leap_M;
Modified_Date_M := Modified_Date_M - Time (Elapsed_Leaps) * Mili;
if Leap_Sec then
Modified_Date_M := Modified_Date_M - Time (1) * Mili;
end if;
-- Step 2: Time zone processing
if Time_Zone /= 0 then
Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Mili;
if Time_Zone < 0 then
Modified_Date_M := Modified_Date_M - Abs_Time_Zone;
else
Modified_Date_M := Modified_Date_M + Abs_Time_Zone;
end if;
end if;
-- After the leap seconds and time zone have been accounted for,
-- the date should be within the bounds of Ada time.
if Modified_Date_M < Ada_Low
or else Modified_Date_M >= Ada_High
then
raise Time_Error;
end if;
-- Step 3: Sub second processing
Sub_Sec := Duration (Modified_Date_M mod Mili) / Mili_F;
-- Drop the sub seconds
Modified_Date_M := Modified_Date_M - (Modified_Date_M mod Mili);
-- Step 4: VMS system call
Numtim (Status, Timbuf, Modified_Date_M);
if Status mod 2 /= 1
or else Timbuf (1) not in Ada_Min_Year .. Ada_Max_Year
then
raise Time_Error;
end if;
-- Step 5: Time components processing
Year := Year_Number (Timbuf (1));
Month := Month_Number (Timbuf (2));
Day := Day_Number (Timbuf (3));
Hour := Integer (Timbuf (4));
Minute := Integer (Timbuf (5));
Second := Integer (Timbuf (6));
---------------------- Day_Secs := Day_Duration (Hour * 3_600) +
-- All_Leap_Seconds -- Day_Duration (Minute * 60) +
---------------------- Day_Duration (Second) +
Sub_Sec;
end Split;
-------------
-- Time_Of --
-------------
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Day_Secs : Day_Duration;
Hour : Integer;
Minute : Integer;
Second : Integer;
Sub_Sec : Duration;
Leap_Sec : Boolean;
Leap_Checks : Boolean;
Use_Day_Secs : Boolean;
Time_Zone : Long_Integer) return Time
is
procedure Cvt_Vectim
(Status : out Unsigned_Longword;
Input_Time : Unsigned_Word_Array;
Resultant_Time : out Time);
pragma Interface (External, Cvt_Vectim);
pragma Import_Valued_Procedure
(Cvt_Vectim, "LIB$CVT_VECTIM",
(Unsigned_Longword, Unsigned_Word_Array, Time),
(Value, Reference, Reference));
Status : Unsigned_Longword;
Timbuf : Unsigned_Word_Array (1 .. 7);
Mili_F : constant := 10_000_000.0;
Ada_High_And_Leaps : constant Time :=
Ada_High + Time (All_Leap_Seconds) * Mili;
H : Integer := Hour;
Mi : Integer := Minute;
Se : Integer := Second;
Su : Duration := Sub_Sec;
Abs_Time_Zone : Time;
Adjust_Day : Boolean := False;
Elapsed_Leaps : Natural;
Int_Day_Secs : Integer;
Next_Leap_M : Time;
Result_M : Time;
Rounded_Result_M : Time;
function All_Leap_Seconds return Duration is
begin begin
raise Unimplemented; -- No validity checks are performed on the input values since it is
return 0.0; -- assumed that the called has already performed them.
end All_Leap_Seconds;
-- Step 1: Hour, minute, second and sub second processing
if Use_Day_Secs then
-- A day seconds value of 86_400 designates a new day. The time
-- components are reset to zero, but an additional day will be
-- added after the system call.
if Day_Secs = 86_400.0 then
Adjust_Day := True;
H := 0;
Mi := 0;
Se := 0;
else
-- Sub second extraction
if Day_Secs > 0.0 then
Int_Day_Secs := Integer (Day_Secs - 0.5);
else
Int_Day_Secs := Integer (Day_Secs);
end if;
H := Int_Day_Secs / 3_600;
Mi := (Int_Day_Secs / 60) mod 60;
Se := Int_Day_Secs mod 60;
Su := Day_Secs - Duration (Int_Day_Secs);
end if;
end if;
-- Step 2: System call to VMS
Timbuf (1) := Unsigned_Word (Year);
Timbuf (2) := Unsigned_Word (Month);
Timbuf (3) := Unsigned_Word (Day);
Timbuf (4) := Unsigned_Word (H);
Timbuf (5) := Unsigned_Word (Mi);
Timbuf (6) := Unsigned_Word (Se);
Timbuf (7) := 0;
Cvt_Vectim (Status, Timbuf, Result_M);
if Status mod 2 /= 1 then
raise Time_Error;
end if;
-- Step 3: Potential day adjustment
if Use_Day_Secs
and then Adjust_Day
then
Result_M := Result_M + Milis_In_Day;
end if;
-- Step 4: Sub second adjustment
Result_M := Result_M + Time (Su * Mili_F);
-- Step 5: Time zone processing
if Time_Zone /= 0 then
Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Mili;
if Time_Zone < 0 then
Result_M := Result_M + Abs_Time_Zone;
else
Result_M := Result_M - Abs_Time_Zone;
end if;
end if;
-- Step 6: Leap seconds processing
-- Start of processing in package Leap_Sec_Ops Cumulative_Leap_Seconds
(Ada_Low, Result_M, Elapsed_Leaps, Next_Leap_M);
Result_M := Result_M + Time (Elapsed_Leaps) * Mili;
-- An Ada 2005 caller requesting an explicit leap second or an Ada
-- 95 caller accounting for an invisible leap second.
Rounded_Result_M := Result_M - (Result_M mod Mili);
if Leap_Sec
or else Rounded_Result_M = Next_Leap_M
then
Result_M := Result_M + Time (1) * Mili;
Rounded_Result_M := Rounded_Result_M + Time (1) * Mili;
end if;
-- Leap second validity check
if Leap_Checks
and then Leap_Sec
and then Rounded_Result_M /= Next_Leap_M
then
raise Time_Error;
end if;
-- Bounds check
if Result_M < Ada_Low
or else Result_M >= Ada_High_And_Leaps
then
raise Time_Error;
end if;
return Result_M;
end Time_Of;
end Formatting_Operations;
---------------------------
-- Time_Zones_Operations --
---------------------------
package body Time_Zones_Operations is
---------------------
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time) return Long_Integer is
-- Formal parameter Date is here for interfacing, but is never
-- actually used.
pragma Unreferenced (Date);
function get_gmtoff return Long_Integer;
pragma Import (C, get_gmtoff, "get_gmtoff");
begin
-- VMS is not capable of determining the time zone in some past or
-- future point in time denoted by Date, thus the current time zone
-- is retrieved.
return get_gmtoff;
end UTC_Time_Offset;
end Time_Zones_Operations;
-- Start of elaboration code for Ada.Calendar
begin
-- Population of the leap seconds table
declare
type Leap_Second_Date is record
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
end record;
Leap_Second_Dates :
constant array (1 .. N_Leap_Seconds) of Leap_Second_Date :=
((1972, 6, 30), (1972, 12, 31), (1973, 12, 31), (1974, 12, 31),
(1975, 12, 31), (1976, 12, 31), (1977, 12, 31), (1978, 12, 31),
(1979, 12, 31), (1981, 6, 30), (1982, 6, 30), (1983, 6, 30),
(1985, 6, 30), (1987, 12, 31), (1989, 12, 31), (1990, 12, 31),
(1992, 6, 30), (1993, 6, 30), (1994, 6, 30), (1995, 12, 31),
(1997, 6, 30), (1998, 12, 31), (2005, 12, 31));
Ada_Min_Year : constant Year_Number := Year_Number'First;
Days_In_Four_Years : constant := 365 * 3 + 366;
VMS_Days : constant := 10 * 366 + 32 * 365 + 45;
Days : Natural;
Leap : Leap_Second_Date;
Years : Natural;
begin begin
null; for Index in 1 .. N_Leap_Seconds loop
end Leap_Sec_Ops; Leap := Leap_Second_Dates (Index);
-- Calculate the number of days from the start of Ada time until
-- the current leap second occurence. Non-leap centenial years
-- are not accounted for in these calculations since there are
-- no leap seconds after 2100 yet.
Years := Leap.Year - Ada_Min_Year;
Days := (Years / 4) * Days_In_Four_Years;
Years := Years mod 4;
if Years = 1 then
Days := Days + 365;
elsif Years = 2 then
Days := Days + 365 * 2;
elsif Years = 3 then
Days := Days + 365 * 3;
end if;
Days := Days + Cumulative_Days_Before_Month (Leap.Month);
if Is_Leap (Leap.Year)
and then Leap.Month > 2
then
Days := Days + 1;
end if;
-- Add the number of days since the start of VMS time till the
-- start of Ada time.
Days := Days + Leap.Day + VMS_Days;
-- Index - 1 previous leap seconds are added to Time (Index)
Leap_Second_Times (Index) :=
(Time (Days) * Secs_In_Day + Time (Index - 1)) * Mili;
end loop;
end;
end Ada.Calendar; end Ada.Calendar;
gcc/ada/a-calend-vms.ads
...@@ -44,11 +44,12 @@ package Ada.Calendar is ...@@ -44,11 +44,12 @@ package Ada.Calendar is
type Time is private; type Time is private;
-- Declarations representing limits of allowed local time values. Note that -- Declarations representing limits of allowed local time values. Note
-- these do NOT constrain the possible stored values of time which may well -- that these do NOT constrain the possible stored values of time which
-- permit a larger range of times (this is explicitly allowed in Ada 95). -- 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 Month_Number is Integer range 1 .. 12;
subtype Day_Number is Integer range 1 .. 31; subtype Day_Number is Integer range 1 .. 31;
...@@ -72,8 +73,7 @@ package Ada.Calendar is ...@@ -72,8 +73,7 @@ package Ada.Calendar is
(Year : Year_Number; (Year : Year_Number;
Month : Month_Number; Month : Month_Number;
Day : Day_Number; Day : Day_Number;
Seconds : Day_Duration := 0.0) Seconds : Day_Duration := 0.0) return Time;
return Time;
function "+" (Left : Time; Right : Duration) return Time; function "+" (Left : Time; Right : Duration) return Time;
function "+" (Left : Duration; Right : Time) return Time; function "+" (Left : Duration; Right : Time) return Time;
...@@ -87,10 +87,7 @@ package Ada.Calendar is ...@@ -87,10 +87,7 @@ package Ada.Calendar is
Time_Error : exception; Time_Error : exception;
Unimplemented : exception;
private private
pragma Inline (Clock); pragma Inline (Clock);
pragma Inline (Year); pragma Inline (Year);
...@@ -105,81 +102,107 @@ private ...@@ -105,81 +102,107 @@ private
pragma Inline (">"); pragma Inline (">");
pragma Inline (">="); pragma Inline (">=");
-- Time is represented as the number of 100-nanosecond (ns) units offset -- Although the units are 100 nanoseconds, for the purpose of better
-- from the system base date and time, which is 00:00 o'clock, -- readability, this unit will be called "mili".
-- November 17, 1858 (the Smithsonian base date and time for the
-- astronomic calendar). 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 -- 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 -- Unix environments. If this is the case then Split and Time_Of perform
-- required conversions to and from local times. -- 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. -- Notwithstanding this definition, Time is not quite the same as OS_Time.
-- Relative Time is positive, whereas relative OS_Time is negative, -- Relative Time is positive, whereas relative OS_Time is negative,
-- but this declaration makes for easier conversion. -- but this declaration makes for easier conversion.
-- The following package provides handling of leap seconds. It is type Time is new OSP.OS_Time;
-- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both
-- Ada 2005 children of Ada.Calendar. -- The range of Ada time expressed as milis since the VMS Epoch
package Leap_Sec_Ops is Ada_Low : constant Time := (10 * 366 + 32 * 365 + 45) * Milis_In_Day;
Ada_High : constant Time := (131 * 366 + 410 * 365 + 45) * Milis_In_Day;
After_Last_Leap : constant Time := Time'Last;
-- Bigger by far than any leap second value. Not within range of Days_In_Month : constant array (Month_Number) of Day_Number :=
-- Ada.Calendar specified dates. (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
procedure Cumulative_Leap_Secs Invalid_Time_Zone_Offset : Long_Integer;
(Start_Date : Time; pragma Import (C, Invalid_Time_Zone_Offset, "__gnat_invalid_tzoff");
End_Date : Time;
Leaps_Between : out Duration; function Is_Leap (Year : Year_Number) return Boolean;
Next_Leap_Sec : out Time); -- Determine whether a given year is leap
-- Leaps_Between is the sum of the leap seconds that have occured
-- on or after Start_Date and before (strictly before) End_Date. -- The following packages provide a target independent interface to the
-- Next_Leap_Sec represents the next leap second occurence on or -- children of Calendar - Arithmetic, Formatting and Time_Zones.
-- after End_Date. If there are no leaps seconds after End_Date,
-- After_Last_Leap is returned. This does not provide info about -- NOTE: Delays does not need a target independent interface because
-- the next leap second (pos/neg or ?). After_Last_Leap can be used -- VMS already has a target specific file for that package.
-- as End_Date to count all the leap seconds that have occured on
-- or after Start_Date. package Arithmetic_Operations is
-- function Add (Date : Time; Days : Long_Integer) return Time;
-- Important Notes: any fractional parts of Start_Date and End_Date -- Add X number of days to a time value
-- 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 procedure Difference
-- End_Date, the leap second at 113 will not be counted in (Left : Time;
-- Leaps_Between, but it will be returned as Next_Leap_Sec. Thus, if Right : Time;
-- the caller wants to know if the End_Date is a leap second, the Days : out Long_Integer;
-- comparison should be: Seconds : out Duration;
-- Leap_Seconds : out Integer);
-- End_Date >= Next_Leap_Sec; -- Calculate the difference between two time values in terms of days,
-- -- seconds and leap seconds elapsed. The leap seconds are not included
-- After_Last_Leap is designed so that this comparison works without -- in the seconds returned. If Left is greater than Right, the returned
-- having to first check if Next_Leap_Sec is a valid leap second. -- values are positive, negative otherwise.
function All_Leap_Seconds return Duration; function Subtract (Date : Time; Days : Long_Integer) return Time;
-- Returns the sum off all of the leap seoncds. -- Subtract X number of days from a time value
end Arithmetic_Operations;
end Leap_Sec_Ops;
package Formatting_Operations is
procedure Split_With_Offset function Day_Of_Week (Date : Time) return Integer;
(Date : Time; -- Determine which day of week Date falls on. The returned values are
Year : out Year_Number; -- within the range of 0 .. 6 (Monday .. Sunday).
Month : out Month_Number;
Day : out Day_Number; procedure Split
Seconds : out Day_Duration; (Date : Time;
Offset : out Long_Integer); Year : out Year_Number;
-- Split_W_Offset has the same spec as Split with the addition of an Month : out Month_Number;
-- offset value which give the offset of the local time zone from UTC Day : out Day_Number;
-- at the input Date. This value comes for free during the implementation Day_Secs : out Day_Duration;
-- of Split and is needed by UTC_Time_Offset. The returned Offset time Hour : out Integer;
-- is straight from the C tm struct and is in seconds. If the system Minute : out Integer;
-- dependent code has no way to find the offset it will return the value Second : out Integer;
-- Invalid_TZ_Offset declared below. Otherwise no checking is done, so Sub_Sec : out Duration;
-- it is up to the user to check both for Invalid_TZ_Offset and otherwise Leap_Sec : out Boolean;
-- for a value that is acceptable. Time_Zone : Long_Integer);
-- Split a time value into its components
Invalid_TZ_Offset : Long_Integer;
pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff"); 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; end Ada.Calendar;
gcc/ada/a-calend.adb
...@@ -31,100 +31,118 @@ ...@@ -31,100 +31,118 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Unchecked_Conversion; with Ada.Unchecked_Conversion;
with System.OS_Primitives; with System.OS_Primitives;
-- used for Clock -- used for Clock
package body Ada.Calendar is package body Ada.Calendar is
------------------------------ --------------------------
-- Use of Pragma Unsuppress -- -- Implementation Notes --
------------------------------ --------------------------
-- This implementation of Calendar takes advantage of the permission in -- In complex algorithms, some variables of type Ada.Calendar.Time carry
-- Ada 95 of using arithmetic overflow checks to check for out of bounds -- suffix _S or _N to denote units of seconds or nanoseconds.
-- time values. This means that we must catch the constraint error that --
-- results from arithmetic overflow, so we use pragma Unsuppress to make -- Because time is measured in different units and from different origins
-- sure that overflow is enabled, using software overflow checking if -- on various targets, a system independent model is incorporated into
-- necessary. That way, compiling Calendar with options to suppress this -- Ada.Calendar. The idea behing the design is to encapsulate all target
-- checking will not affect its correctness. -- dependent machinery in a single package, thus providing a uniform
-- interface to any existing and potential children.
------------------------
-- Local Declarations -- -- package Ada.Calendar
------------------------ -- procedure Split (5 parameters) -------+
-- | Call from local routine
type char_Pointer is access Character; -- private |
subtype int is Integer; -- package Formatting_Operations |
subtype long is Long_Integer; -- procedure Split (11 parameters) <--+
type long_Pointer is access all long; -- end Formatting_Operations |
-- Synonyms for C types. We don't want to get them from Interfaces.C -- end Ada.Calendar |
-- because there is no point in loading that unit just for calendar. -- |
-- package Ada.Calendar.Formatting | Call from child routine
type tm is record -- procedure Split (9 or 10 parameters) -+
tm_sec : int; -- seconds after the minute (0 .. 60) -- end Ada.Calendar.Formatting
tm_min : int; -- minutes after the hour (0 .. 59)
tm_hour : int; -- hours since midnight (0 .. 24) -- The behaviour of the interfacing routines is controlled via various
tm_mday : int; -- day of the month (1 .. 31) -- flags. All new Ada 2005 types from children of Ada.Calendar are
tm_mon : int; -- months since January (0 .. 11) -- emulated by a similar type. For instance, type Day_Number is replaced
tm_year : int; -- years since 1900 -- by Integer in various routines. One ramification of this model is that
tm_wday : int; -- days since Sunday (0 .. 6) -- the caller site must perform validity checks on returned results.
tm_yday : int; -- days since January 1 (0 .. 365) -- The end result of this model is the lack of target specific files per
tm_isdst : int; -- Daylight Savings Time flag (-1 .. +1) -- child of Ada.Calendar (a-calfor, a-calfor-vms, a-calfor-vxwors, etc).
tm_gmtoff : long; -- offset from CUT in seconds
tm_zone : char_Pointer; -- timezone abbreviation -----------------------
end record; -- Local Subprograms --
-----------------------
type tm_Pointer is access all tm;
procedure Cumulative_Leap_Seconds
subtype time_t is long; (Start_Date : Time;
End_Date : Time;
type time_t_Pointer is access all time_t; Elapsed_Leaps : out Natural;
Next_Leap_Sec : out Time);
procedure localtime_tzoff -- Elapsed_Leaps is the sum of the leap seconds that have occured on or
(C : time_t_Pointer; -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
res : tm_Pointer; -- represents the next leap second occurence on or after End_Date. If
off : long_Pointer); -- there are no leaps seconds after End_Date, After_Last_Leap is returned.
pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff"); -- After_Last_Leap can be used as End_Date to count all the leap seconds
-- This is a lightweight wrapper around the system library localtime_r -- that have occured on or after Start_Date.
-- function. Parameter 'off' captures the UTC offset which is either --
-- retrieved from the tm struct or calculated from the 'timezone' extern -- Note: Any sub seconds of Start_Date and End_Date are discarded before
-- and the tm_isdst flag in the tm struct. -- 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
function mktime (TM : tm_Pointer) return time_t; -- at 113 will not be counted in Leaps_Between, but it will be returned
pragma Import (C, mktime); -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
-- mktime returns -1 in case the calendar time given by components of -- a leap second, the comparison should be:
-- TM.all cannot be represented. --
-- End_Date >= Next_Leap_Sec;
-- 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 - -- After_Last_Leap is designed so that this comparison works without
-- 2026 excluded). Dates that are not in this 56 year range are shifted -- having to first check if Next_Leap_Sec is a valid leap second.
-- by multiples of 56 years to fit in this range.
function To_Abs_Duration (T : Time) return Duration;
-- The trick is that the number of days in any four year period in the Ada -- Convert a time value into a duration value. Note that the returned
-- range of years (1901 - 2099) has a constant number of days. This is -- duration is always positive.
-- 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, function To_Abs_Time (D : Duration) return Time;
-- because it is not only a multiple of 4, but also a multiple of 7. Thus -- Return the time equivalent of a duration value. Since time cannot be
-- two dates 56 years apart fall on the same day of the week, and the -- negative, the absolute value of D is used. It is upto the called to
-- Daylight Saving Time change dates are usually the same for these two -- decide how to handle negative durations converted into time.
-- years.
---------------------
Unix_Year_Min : constant := 1970; -- Local Constants --
Unix_Year_Max : constant := 2026; ---------------------
Ada_Year_Min : constant := 1901; Ada_Min_Year : constant Year_Number := Year_Number'First;
Ada_Year_Max : constant := 2099; After_Last_Leap : constant Time := Time'Last;
Leap_Seconds_Count : constant Natural := 23;
-- Some basic constants used throughout Secs_In_Four_Years : constant := (3 * 365 + 366) * Secs_In_Day;
Secs_In_Non_Leap_Year : constant := 365 * Secs_In_Day;
Days_In_Month : constant array (Month_Number) of Day_Number := Time_Zero : constant Time := Time'First;
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
-- Even though the upper bound of Ada time is 2399-12-31 86_399.999999999
Days_In_4_Years : constant := 365 * 3 + 366; -- GMT, it must be shifted to include all leap seconds.
Seconds_In_4_Years : constant := 86_400 * Days_In_4_Years;
Seconds_In_56_Years : constant := Seconds_In_4_Years * 14; Ada_High_And_Leaps : constant Time :=
Seconds_In_56_YearsD : constant := Duration (Seconds_In_56_Years); Ada_High + Time (Leap_Seconds_Count) * Nano;
Hard_Ada_High_And_Leaps : constant Time :=
Hard_Ada_High +
Time (Leap_Seconds_Count) * Nano;
-- The Unix lower time bound expressed as nanoseconds since the
-- start of Ada time in GMT.
Unix_Min : constant Time := (17 * 366 + 52 * 365) * Nanos_In_Day;
Cumulative_Days_Before_Month :
constant array (Month_Number) of Natural :=
(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
Leap_Second_Times : array (1 .. Leap_Seconds_Count) of Time;
-- Each value represents a time value which is one second before a leap
-- second occurence. This table is populated during the elaboration of
-- Ada.Calendar.
--------- ---------
-- "+" -- -- "+" --
...@@ -132,30 +150,98 @@ package body Ada.Calendar is ...@@ -132,30 +150,98 @@ package body Ada.Calendar is
function "+" (Left : Time; Right : Duration) return Time is function "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check); pragma Unsuppress (Overflow_Check);
begin begin
return (Left + Time (Right)); if Right = 0.0 then
return Left;
elsif Right < 0.0 then
-- Type Duration has one additional number in its negative subrange,
-- which is Duration'First. The subsequent invocation of "-" will
-- perform among other things an Unchecked_Conversion on that
-- particular value, causing overflow. If not properly handled,
-- the erroneous value will cause an infinite recursion between "+"
-- and "-". To properly handle this boundary case, we make a small
-- adjustment of one second to Duration'First.
if Right = Duration'First then
return Left - abs (Right + 1.0) - 1.0;
else
return Left - abs (Right);
end if;
else
declare
-- The input time value has been normalized to GMT
Result : constant Time := Left + To_Abs_Time (Right);
begin
-- The end result may excede the upper bound of Ada time. Note
-- that the comparison operator is ">=" rather than ">" since
-- the smallest increment of 0.000000001 to the legal end of
-- time (2399-12-31 86_399.999999999) will render the result
-- equal to Ada_High (2400-1-1 0.0).
if Result >= Ada_High_And_Leaps then
raise Time_Error;
end if;
return Result;
end;
end if;
exception exception
when Constraint_Error => when Constraint_Error =>
raise Time_Error; raise Time_Error;
end "+"; end "+";
function "+" (Left : Duration; Right : Time) return Time is function "+" (Left : Duration; Right : Time) return Time is
pragma Unsuppress (Overflow_Check);
begin begin
return (Time (Left) + Right); return Right + Left;
exception
when Constraint_Error =>
raise Time_Error;
end "+"; end "+";
--------- ---------
-- "-" -- -- "-" --
--------- ---------
function "-" (Left : Time; Right : Duration) return Time is function "-" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check); pragma Unsuppress (Overflow_Check);
begin begin
return Left - Time (Right); if Right = 0.0 then
return Left;
elsif Right < 0.0 then
return Left + abs (Right);
else
declare
Result : Time;
Right_T : constant Time := To_Abs_Time (Right);
begin
-- Subtracting a larger time value from a smaller time value
-- will cause a wrap around since Time is a modular type. Note
-- that the time value has been normalized to GMT.
if Left < Right_T then
raise Time_Error;
end if;
Result := Left - Right_T;
if Result < Ada_Low
or else Result > Ada_High_And_Leaps
then
raise Time_Error;
end if;
return Result;
end;
end if;
exception exception
when Constraint_Error => when Constraint_Error =>
raise Time_Error; raise Time_Error;
...@@ -163,8 +249,55 @@ package body Ada.Calendar is ...@@ -163,8 +249,55 @@ package body Ada.Calendar is
function "-" (Left : Time; Right : Time) return Duration is function "-" (Left : Time; Right : Time) return Duration is
pragma Unsuppress (Overflow_Check); 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 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 exception
when Constraint_Error => when Constraint_Error =>
raise Time_Error; raise Time_Error;
...@@ -176,7 +309,7 @@ package body Ada.Calendar is ...@@ -176,7 +309,7 @@ package body Ada.Calendar is
function "<" (Left, Right : Time) return Boolean is function "<" (Left, Right : Time) return Boolean is
begin begin
return Duration (Left) < Duration (Right); return Time_Rep (Left) < Time_Rep (Right);
end "<"; end "<";
---------- ----------
...@@ -185,7 +318,7 @@ package body Ada.Calendar is ...@@ -185,7 +318,7 @@ package body Ada.Calendar is
function "<=" (Left, Right : Time) return Boolean is function "<=" (Left, Right : Time) return Boolean is
begin begin
return Duration (Left) <= Duration (Right); return Time_Rep (Left) <= Time_Rep (Right);
end "<="; end "<=";
--------- ---------
...@@ -194,7 +327,7 @@ package body Ada.Calendar is ...@@ -194,7 +327,7 @@ package body Ada.Calendar is
function ">" (Left, Right : Time) return Boolean is function ">" (Left, Right : Time) return Boolean is
begin begin
return Duration (Left) > Duration (Right); return Time_Rep (Left) > Time_Rep (Right);
end ">"; end ">";
---------- ----------
...@@ -203,7 +336,7 @@ package body Ada.Calendar is ...@@ -203,7 +336,7 @@ package body Ada.Calendar is
function ">=" (Left, Right : Time) return Boolean is function ">=" (Left, Right : Time) return Boolean is
begin begin
return Duration (Left) >= Duration (Right); return Time_Rep (Left) >= Time_Rep (Right);
end ">="; end ">=";
----------- -----------
...@@ -211,36 +344,179 @@ package body Ada.Calendar is ...@@ -211,36 +344,179 @@ package body Ada.Calendar is
----------- -----------
function Clock return Time 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 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; 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 -- -- Day --
--------- ---------
function Day (Date : Time) return Day_Number is function Day (Date : Time) return Day_Number is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DD; return D;
end Day; 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 -- -- Month --
----------- -----------
function Month (Date : Time) return Month_Number is function Month (Date : Time) return Month_Number is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DM; return M;
end Month; end Month;
------------- -------------
...@@ -248,13 +524,13 @@ package body Ada.Calendar is ...@@ -248,13 +524,13 @@ package body Ada.Calendar is
------------- -------------
function Seconds (Date : Time) return Day_Duration is function Seconds (Date : Time) return Day_Duration is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DS; return S;
end Seconds; end Seconds;
----------- -----------
...@@ -268,438 +544,999 @@ package body Ada.Calendar is ...@@ -268,438 +544,999 @@ package body Ada.Calendar is
Day : out Day_Number; Day : out Day_Number;
Seconds : out Day_Duration) Seconds : out Day_Duration)
is 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 begin
Split_With_Offset (Date, Year, Month, Day, Seconds, Offset); Formatting_Operations.Split
end Split; (Date, Year, Month, Day, Seconds, H, M, Se, Ss, Le, Tz);
----------------------- -- Validity checks
-- Split_With_Offset --
-----------------------
procedure Split_With_Offset if not Year'Valid
(Date : Time; or else not Month'Valid
Year : out Year_Number; or else not Day'Valid
Month : out Month_Number; or else not Seconds'Valid
Day : out Day_Number; then
Seconds : out Day_Duration; raise Time_Error;
Offset : out Long_Integer) end if;
is end Split;
-- The following declare bounds for duration that are comfortably
-- wider than the maximum allowed output result for the Ada range
-- of representable split values. These are used for a quick check
-- that the value is not wildly out of range.
Low : constant := (Ada_Year_Min - Unix_Year_Min - 2) * 365 * 86_400; -------------
High : constant := (Ada_Year_Max - Unix_Year_Min + 2) * 365 * 86_400; -- Time_Of --
-------------
LowD : constant Duration := Duration (Low); function Time_Of
HighD : constant Duration := Duration (High); (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; Mid_Offset : Long_Integer;
D : Duration; Mid_Result : Time;
Frac_Sec : Duration; Offset : Long_Integer;
Local_Offset : aliased long;
Tm_Val : aliased tm;
Year_Val : Integer;
begin begin
-- For us a time is simply a signed duration value, so we work with if not Year'Valid
-- this duration value directly. Note that it can be negative. or else not Month'Valid
or else not Day'Valid
D := Duration (Date); or else not Seconds'Valid
then
-- First of all, filter out completely ludicrous values. Remember that
-- we use the full stored range of duration values, which may be
-- significantly larger than the allowed range of Ada times. Note that
-- these checks are wider than required to make absolutely sure that
-- there are no end effects from time zone differences.
if D < LowD or else D > HighD then
raise Time_Error; raise Time_Error;
end if; end if;
-- The unix localtime_r function is more or less exactly what we need -- Building a time value in a local time zone is tricky since the
-- here. The less comes from the fact that it does not support the -- local time zone offset at the point of creation may not be the
-- required range of years (the guaranteed range available is only -- same as the actual time zone offset designated by the input
-- EPOCH through EPOCH + N seconds). N is in practice 2 ** 31 - 1. -- 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 -- We first start by obtaining the current local time zone offset
-- in the required range by adding multiples of 56 years. For the range -- using Ada.Calendar.Clock, then building an intermediate time
-- we are interested in, the number of days in any consecutive 56 year -- value using that offset.
-- period is constant. Then we do the split on the adjusted value, and
-- readjust the years value accordingly.
Year_Val := 0;
while D < 0.0 loop
D := D + Seconds_In_56_YearsD;
Year_Val := Year_Val - 56;
end loop;
while D >= Seconds_In_56_YearsD loop Mid_Offset := Time_Zones_Operations.UTC_Time_Offset (Clock) / 60;
D := D - Seconds_In_56_YearsD; Mid_Result := Formatting_Operations.Time_Of
Year_Val := Year_Val + 56; (Year, Month, Day, Seconds, H, M, Se, Ss,
end loop; Leap_Sec => False,
Leap_Checks => False,
Use_Day_Secs => True,
Time_Zone => Mid_Offset);
-- Now we need to take the value D, which is now non-negative, and -- This is the true local time zone offset of the input time values
-- break it down into seconds (to pass to the localtime_r function) and
-- fractions of seconds (for the adjustment below).
-- Surprisingly there is no easy way to do this in Ada, and certainly Offset := Time_Zones_Operations.UTC_Time_Offset (Mid_Result) / 60;
-- no easy way to do it and generate efficient code. Therefore we do it
-- at a low level, knowing that it is really represented as an integer
-- with units of Small
declare -- It is possible that at the point of invocation of Time_Of, both
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1; -- the current local time zone offset and the one designated by the
for D_Int'Size use Duration'Size; -- input values are in the same DST mode.
function To_D_Int is new Unchecked_Conversion (Duration, D_Int); if Offset = Mid_Offset then
function To_Duration is new Unchecked_Conversion (D_Int, Duration); return Mid_Result;
D_As_Int : constant D_Int := To_D_Int (D); -- In this case we must calculate the new time with the new offset. It
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small); -- is no sufficient to just take the relative difference between the
-- two offsets and adjust the intermediate result, because this does not
-- work around leap second times.
begin
Adjusted_Seconds := time_t (D_As_Int / Small_Div);
Frac_Sec := To_Duration (D_As_Int rem Small_Div);
end;
localtime_tzoff
(Adjusted_Seconds'Unchecked_Access,
Tm_Val'Unchecked_Access,
Local_Offset'Unchecked_Access);
Year_Val := Tm_Val.tm_year + 1900 + Year_Val;
Month := Tm_Val.tm_mon + 1;
Day := Tm_Val.tm_mday;
Offset := Long_Integer (Local_Offset);
-- The Seconds value is a little complex. The localtime function
-- returns the integral number of seconds, which is what we want, but
-- we want to retain the fractional part from the original Time value,
-- since this is typically stored more accurately.
Seconds := Duration (Tm_Val.tm_hour * 3600 +
Tm_Val.tm_min * 60 +
Tm_Val.tm_sec)
+ Frac_Sec;
-- Note: the above expression is pretty horrible, one of these days we
-- should stop using time_of and do everything ourselves to avoid these
-- unnecessary divides and multiplies???.
-- The Year may still be out of range, since our entry test was
-- deliberately crude. Trying to make this entry test accurate is
-- tricky due to time zone adjustment issues affecting the exact
-- boundary. It is interesting to note that whether or not a given
-- Calendar.Time value gets Time_Error when split depends on the
-- current time zone setting.
if Year_Val not in Ada_Year_Min .. Ada_Year_Max then
raise Time_Error;
else else
Year := Year_Val; declare
Result : constant Time :=
Formatting_Operations.Time_Of
(Year, Month, Day, Seconds, H, M, Se, Ss,
Leap_Sec => False,
Leap_Checks => False,
Use_Day_Secs => True,
Time_Zone => Offset);
begin
return Result;
end;
end if; end if;
end Split_With_Offset; end Time_Of;
-------------
-- Time_Of --
-------------
function Time_Of ---------------------
(Year : Year_Number; -- To_Abs_Duration --
Month : Month_Number; ---------------------
Day : Day_Number;
Seconds : Day_Duration := 0.0)
return Time
is
Result_Secs : aliased time_t;
TM_Val : aliased tm;
Int_Secs : constant Integer := Integer (Seconds);
Year_Val : Integer := Year; function To_Abs_Duration (T : Time) return Duration is
Duration_Adjust : Duration := 0.0; pragma Unsuppress (Overflow_Check);
function To_Duration is new Ada.Unchecked_Conversion (Time, Duration);
begin begin
-- The following checks are redundant with respect to the constraint return To_Duration (T);
-- error checks that should normally be made on parameters, but we
-- decide to raise Constraint_Error in any case if bad values come in
-- (as a result of checks being off in the caller, or for other
-- erroneous or bounded error cases).
if not Year 'Valid
or else not Month 'Valid
or else not Day 'Valid
or else not Seconds'Valid
then
raise Constraint_Error;
end if;
-- Check for Day value too large (one might expect mktime to do this exception
-- check, as well as the basic checks we did with 'Valid, but it seems when Constraint_Error =>
-- that at least on some systems, this built-in check is too weak).
if Day > Days_In_Month (Month)
and then (Day /= 29 or Month /= 2 or Year mod 4 /= 0)
then
raise Time_Error; raise Time_Error;
end if; end To_Abs_Duration;
TM_Val.tm_sec := Int_Secs mod 60;
TM_Val.tm_min := (Int_Secs / 60) mod 60;
TM_Val.tm_hour := (Int_Secs / 60) / 60;
TM_Val.tm_mday := Day;
TM_Val.tm_mon := Month - 1;
-- For the year, we have to adjust it to a year that Unix can handle.
-- We do this in 56 year steps, since the number of days in 56 years is
-- constant, so the timezone effect on the conversion from local time
-- to GMT is unaffected; also the DST change dates are usually not
-- modified.
while Year_Val < Unix_Year_Min loop
Year_Val := Year_Val + 56;
Duration_Adjust := Duration_Adjust - Seconds_In_56_YearsD;
end loop;
while Year_Val >= Unix_Year_Max loop -----------------
Year_Val := Year_Val - 56; -- To_Abs_Time --
Duration_Adjust := Duration_Adjust + Seconds_In_56_YearsD; -----------------
end loop;
TM_Val.tm_year := Year_Val - 1900; function To_Abs_Time (D : Duration) return Time is
pragma Unsuppress (Overflow_Check);
function To_Time is new Ada.Unchecked_Conversion (Duration, Time);
-- If time is very close to UNIX epoch mktime may behave uncorrectly begin
-- because of the way the different time zones are handled (a date -- This operation assumes that D is positive
-- 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.
if Year_Val = Unix_Year_Min if D < 0.0 then
and then Month = 1 raise Constraint_Error;
and then Day = 1
then
TM_Val.tm_mday := TM_Val.tm_mday + 1;
Duration_Adjust := Duration_Adjust - Duration (86400.0);
end if; end if;
-- Since we do not have information on daylight savings, rely on the return To_Time (D);
-- default information.
TM_Val.tm_isdst := -1; exception
Result_Secs := mktime (TM_Val'Unchecked_Access); when Constraint_Error =>
raise Time_Error;
-- That gives us the basic value in seconds. Two adjustments are end To_Abs_Time;
-- needed. First we must undo the year adjustment carried out above.
-- Second we put back the fraction seconds value since in general the
-- Day_Duration value we received has additional precision which we do
-- not want to lose in the constructed result.
return
Time (Duration (Result_Secs) +
Duration_Adjust +
(Seconds - Duration (Int_Secs)));
end Time_Of;
---------- ----------
-- Year -- -- Year --
---------- ----------
function Year (Date : Time) return Year_Number is function Year (Date : Time) return Year_Number is
DY : Year_Number; Y : Year_Number;
DM : Month_Number; M : Month_Number;
DD : Day_Number; D : Day_Number;
DS : Day_Duration; S : Day_Duration;
begin begin
Split (Date, DY, DM, DD, DS); Split (Date, Y, M, D, S);
return DY; return Y;
end Year; end Year;
------------------- -- The following packages assume that Time is a modular 64 bit integer
-- Leap_Sec_Ops -- -- type, the units are nanoseconds and the origin is the start of Ada
------------------- -- time (1901-1-1 0.0).
-- The package that is used by the Ada 2005 children of Ada.Calendar: ---------------------------
-- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting. -- Arithmetic_Operations --
---------------------------
package body Leap_Sec_Ops is package body Arithmetic_Operations is
-- This package must be updated when leap seconds are added. Adding a ---------
-- leap second requires incrementing the value of N_Leap_Secs and adding -- Add --
-- the day of the new leap second to the end of Leap_Second_Dates. ---------
-- Elaboration of the Leap_Sec_Ops package takes care of converting the function Add (Date : Time; Days : Long_Integer) return Time is
-- Leap_Second_Dates table to a form that is better suited for the begin
-- procedures provided by this package (a table that would be more if Days = 0 then
-- difficult to maintain by hand). return Date;
N_Leap_Secs : constant := 23; elsif Days < 0 then
return Subtract (Date, abs (Days));
type Leap_Second_Date is record else
Year : Year_Number; declare
Month : Month_Number; Result : constant Time := Date + Time (Days) * Nanos_In_Day;
Day : Day_Number;
end record;
Leap_Second_Dates : begin
constant array (1 .. N_Leap_Secs) of Leap_Second_Date := -- The result excedes the upper bound of Ada time
((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));
Leap_Second_Times : array (1 .. N_Leap_Secs) of Time; if Result > Ada_High_And_Leaps then
-- This is the needed internal representation that is calculated raise Time_Error;
-- from Leap_Second_Dates during elaboration; end if;
-------------------------- return Result;
-- Cumulative_Leap_Secs -- end;
-------------------------- end if;
procedure Cumulative_Leap_Secs exception
(Start_Date : Time; when Constraint_Error =>
End_Date : Time; raise Time_Error;
Leaps_Between : out Duration; end Add;
Next_Leap_Sec : out Time)
----------------
-- Difference --
----------------
procedure Difference
(Left : Time;
Right : Time;
Days : out Long_Integer;
Seconds : out Duration;
Leap_Seconds : out Integer)
is is
End_T : Time; Diff_N : Time;
K : Positive; Diff_S : Time;
Leap_Index : Positive; Earlier : Time;
Start_Tmp : Time; Elapsed_Leaps : Natural;
Start_T : Time; Later : Time;
Negate : Boolean := False;
Next_Leap : Time;
Sub_Seconds : Duration;
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1; begin
for D_Int'Size use Duration'Size; -- Both input time values are assumed to be in GMT
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); if Left >= Right then
Later := Left;
Earlier := Right;
else
Later := Right;
Earlier := Left;
Negate := True;
end if;
begin -- First process the leap seconds
Next_Leap_Sec := After_Last_Leap;
-- We want to throw away the fractional part of seconds. Before Cumulative_Leap_Seconds (Earlier, Later, Elapsed_Leaps, Next_Leap);
-- proceding with this operation, make sure our working values
-- are non-negative.
if End_Date < 0.0 then if Later >= Next_Leap then
Leaps_Between := 0.0; Elapsed_Leaps := Elapsed_Leaps + 1;
return;
end if; end if;
if Start_Date < 0.0 then Diff_N := Later - Earlier - Time (Elapsed_Leaps) * Nano;
Start_Tmp := Time (0.0);
else -- Sub second processing
Start_Tmp := Start_Date;
Sub_Seconds := Duration (Diff_N mod Nano) / Nano_F;
-- Convert to seconds. Note that his action eliminates the sub
-- seconds automatically.
Diff_S := Diff_N / Nano;
Days := Long_Integer (Diff_S / Secs_In_Day);
Seconds := Duration (Diff_S mod Secs_In_Day) + Sub_Seconds;
Leap_Seconds := Integer (Elapsed_Leaps);
if Negate then
Days := -Days;
Seconds := -Seconds;
Leap_Seconds := -Leap_Seconds;
end if; end if;
end Difference;
if Start_Date <= Leap_Second_Times (N_Leap_Secs) then --------------
-- Subtract --
-- 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. function Subtract (Date : Time; Days : Long_Integer) return Time is
begin
D_As_Int := To_D_As_Int (Duration (Start_Tmp)); if Days = 0 then
D_As_Int := D_As_Int / Small_Div; return Date;
Start_T := Time (D_As_Int);
D_As_Int := To_D_As_Int (Duration (End_Date)); elsif Days < 0 then
D_As_Int := D_As_Int / Small_Div; return Add (Date, abs (Days));
End_T := Time (D_As_Int);
Leap_Index := 1;
loop
exit when Leap_Second_Times (Leap_Index) >= Start_T;
Leap_Index := Leap_Index + 1;
end loop;
K := Leap_Index;
loop
exit when K > N_Leap_Secs or else
Leap_Second_Times (K) >= End_T;
K := K + 1;
end loop;
if K <= N_Leap_Secs then
Next_Leap_Sec := Leap_Second_Times (K);
end if;
Leaps_Between := Duration (K - Leap_Index);
else else
Leaps_Between := Duration (0.0); declare
Days_T : constant Time := Time (Days) * Nanos_In_Day;
Result : Time;
begin
-- Subtracting a larger number of days from a smaller time
-- value will cause wrap around since time is a modular type.
if Date < Days_T then
raise Time_Error;
end if;
Result := Date - Days_T;
if Result < Ada_Low
or else Result > Ada_High_And_Leaps
then
raise Time_Error;
end if;
return Result;
end;
end if; end if;
end Cumulative_Leap_Secs;
---------------------- exception
-- All_Leap_Seconds -- when Constraint_Error =>
---------------------- raise Time_Error;
end Subtract;
end Arithmetic_Operations;
----------------------
-- Delay_Operations --
----------------------
package body Delays_Operations is
-----------------
-- To_Duration --
-----------------
function To_Duration (Ada_Time : Time) return Duration is
Elapsed_Leaps : Natural;
Modified_Time : Time;
Next_Leap : Time;
Result : Duration;
Rounded_Time : Time;
function All_Leap_Seconds return Duration is
begin begin
return Duration (N_Leap_Secs); Modified_Time := Ada_Time;
-- Presumes each leap second is +1.0 second; Rounded_Time := Modified_Time - (Modified_Time mod Nano);
end All_Leap_Seconds;
-- Start of processing in package Leap_Sec_Ops -- Remove all leap seconds
Cumulative_Leap_Seconds
(Time_Zero, Modified_Time, Elapsed_Leaps, Next_Leap);
Modified_Time := Modified_Time - Time (Elapsed_Leaps) * Nano;
-- The input time value may fall on a leap second occurence
if Rounded_Time = Next_Leap then
Modified_Time := Modified_Time - Time (1) * Nano;
end if;
-- Perform a shift in origins
Result := Modified_Time - Unix_Min;
-- Remove the buffer period used in time zone processing
return Result - Buffer_D;
end To_Duration;
end Delays_Operations;
---------------------------
-- Formatting_Operations --
---------------------------
package body Formatting_Operations is
-----------------
-- Day_Of_Week --
-----------------
function Day_Of_Week (Date : Time) return Integer is
Y : Year_Number;
Mo : Month_Number;
D : Day_Number;
Dd : Day_Duration;
H : Integer;
Mi : Integer;
Se : Integer;
Su : Duration;
Le : Boolean;
Day_Count : Long_Integer;
Midday_Date_S : Time;
begin
Formatting_Operations.Split
(Date, Y, Mo, D, Dd, H, Mi, Se, Su, Le, 0);
-- Build a time value in the middle of the same day, remove the
-- lower buffer and convert the time value to seconds.
Midday_Date_S := (Formatting_Operations.Time_Of
(Y, Mo, D, 0.0, 12, 0, 0, 0.0,
Leap_Sec => False,
Leap_Checks => False,
Use_Day_Secs => False,
Time_Zone => 0) - Buffer_N) / Nano;
-- Count the number of days since the start of Ada time. 1901-1-1
-- GMT was a Tuesday.
Day_Count := Long_Integer (Midday_Date_S / Secs_In_Day) + 1;
return Integer (Day_Count mod 7);
end Day_Of_Week;
-----------
-- Split --
-----------
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Day_Secs : out Day_Duration;
Hour : out Integer;
Minute : out Integer;
Second : out Integer;
Sub_Sec : out Duration;
Leap_Sec : out Boolean;
Time_Zone : Long_Integer)
is
-- The following constants represent the number of nanoseconds
-- elapsed since the start of Ada time to and including the non
-- leap centenial years.
Year_2101 : constant Time := (49 * 366 + 151 * 365) * Nanos_In_Day;
Year_2201 : constant Time := (73 * 366 + 227 * 365) * Nanos_In_Day;
Year_2301 : constant Time := (97 * 366 + 303 * 365) * Nanos_In_Day;
Abs_Time_Zone : Time;
Day_Seconds : Natural;
Elapsed_Leaps : Natural;
Four_Year_Segs : Natural;
Hour_Seconds : Natural;
Is_Leap_Year : Boolean;
Modified_Date_N : Time;
Modified_Date_S : Time;
Next_Leap_N : Time;
Rem_Years : Natural;
Rounded_Date_N : Time;
Year_Day : Natural;
begin
declare
Days : Natural;
Is_Leap_Year : Boolean;
Years : Natural;
Cumulative_Days_Before_Month :
constant array (Month_Number) of Natural :=
(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
begin begin
for J in 1 .. N_Leap_Secs loop Modified_Date_N := Date;
Years := Leap_Second_Dates (J).Year - Unix_Year_Min;
Days := (Years / 4) * Days_In_4_Years; if Modified_Date_N < Hard_Ada_Low
Years := Years mod 4; or else Modified_Date_N > Hard_Ada_High_And_Leaps
Is_Leap_Year := False; then
raise Time_Error;
end if;
if Years = 1 then -- Step 1: Leap seconds processing in GMT
Days := Days + 365;
-- Day_Duration: 86_398 86_399 X (86_400) 0 (1) 1 (2)
-- Time : --+-------+-------+----------+------+-->
-- Seconds : 58 59 60 (Leap) 1 2
-- o Modified_Date_N falls between 86_399 and X (86_400)
-- Elapsed_Leaps = X - 1 leaps
-- Rounded_Date_N = 86_399
-- Next_Leap_N = X (86_400)
-- Leap_Sec = False
-- o Modified_Date_N falls exactly on X (86_400)
-- Elapsed_Leaps = X - 1 leaps
-- Rounded_Date_N = X (86_400)
-- Next_Leap_N = X (86_400)
-- Leap_Sec = True
-- An invisible leap second will be added.
-- o Modified_Date_N falls between X (86_400) and 0 (1)
-- Elapsed_Leaps = X - 1 leaps
-- Rounded_Date_N = X (86_400)
-- Next_Leap_N = X (86_400)
-- Leap_Sec = True
-- An invisible leap second will be added.
-- o Modified_Date_N falls on 0 (1)
-- Elapsed_Leaps = X
-- Rounded_Date_N = 0 (1)
-- Next_Leap_N = X + 1
-- Leap_Sec = False
-- The invisible leap second has already been accounted for in
-- Elapsed_Leaps.
Cumulative_Leap_Seconds
(Time_Zero, Modified_Date_N, Elapsed_Leaps, Next_Leap_N);
Rounded_Date_N := Modified_Date_N - (Modified_Date_N mod Nano);
Leap_Sec := Rounded_Date_N = Next_Leap_N;
Modified_Date_N := Modified_Date_N - Time (Elapsed_Leaps) * Nano;
if Leap_Sec then
Modified_Date_N := Modified_Date_N - Time (1) * Nano;
end if;
elsif Years = 2 then -- Step 2: Time zone processing. This action converts the input date
Is_Leap_Year := True; -- from GMT to the requested time zone.
-- 1972 or multiple of 4 after if Time_Zone /= 0 then
Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Nano;
Days := Days + 365 * 2; if Time_Zone < 0 then
-- The following test is obsolete since the date already
-- contains the dedicated buffer for time zones, thus no
-- error will be raised. However it is a good idea to keep
-- it should the representation of time change.
elsif Years = 3 then Modified_Date_N := Modified_Date_N - Abs_Time_Zone;
Days := Days + 365 * 3 + 1; else
Modified_Date_N := Modified_Date_N + Abs_Time_Zone;
end if; end if;
end if;
-- After the elapsed leap seconds have been removed and the date
-- has been normalized, it should fall withing the soft bounds of
-- Ada time.
if Modified_Date_N < Ada_Low
or else Modified_Date_N > Ada_High
then
raise Time_Error;
end if;
-- Before any additional arithmetic is performed we must remove the
-- lower buffer period since it will be accounted as few additional
-- days.
Days := Days + Cumulative_Days_Before_Month Modified_Date_N := Modified_Date_N - Buffer_N;
(Leap_Second_Dates (J).Month);
-- Step 3: Non-leap centenial year adjustment in local time zone
-- In order for all divisions to work properly and to avoid more
-- complicated arithmetic, we add fake Febriary 29s to dates which
-- occur after a non-leap centenial year.
if Modified_Date_N >= Year_2301 then
Modified_Date_N := Modified_Date_N + Time (3) * Nanos_In_Day;
elsif Modified_Date_N >= Year_2201 then
Modified_Date_N := Modified_Date_N + Time (2) * Nanos_In_Day;
elsif Modified_Date_N >= Year_2101 then
Modified_Date_N := Modified_Date_N + Time (1) * Nanos_In_Day;
end if;
if Is_Leap_Year -- Step 4: Sub second processing in local time zone
and then Leap_Second_Dates (J).Month > 2
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 then
Days := Days + 1; Month := 3;
Year_Day := Year_Day - 28;
if Is_Leap_Year then
Year_Day := Year_Day - 1;
end if;
-- Remaining months
while Year_Day > Days_In_Month (Month) loop
Year_Day := Year_Day - Days_In_Month (Month);
Month := Month + 1;
end loop;
end if; end if;
end if;
Days := Days + Leap_Second_Dates (J).Day; -- Step 7: Hour, minute, second and sub second processing in local
-- time zone.
Day := Day_Number (Year_Day);
Day_Seconds := Integer (Modified_Date_S mod Secs_In_Day);
Day_Secs := Duration (Day_Seconds) + Sub_Sec;
Hour := Day_Seconds / 3_600;
Hour_Seconds := Day_Seconds mod 3_600;
Minute := Hour_Seconds / 60;
Second := Hour_Seconds mod 60;
end Split;
-------------
-- Time_Of --
-------------
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Day_Secs : Day_Duration;
Hour : Integer;
Minute : Integer;
Second : Integer;
Sub_Sec : Duration;
Leap_Sec : Boolean;
Leap_Checks : Boolean;
Use_Day_Secs : Boolean;
Time_Zone : Long_Integer) return Time
is
Abs_Time_Zone : Time;
Count : Integer;
Elapsed_Leaps : Natural;
Next_Leap_N : Time;
Result_N : Time;
Rounded_Result_N : Time;
begin
-- Step 1: Check whether the day, month and year form a valid date
if Day > Days_In_Month (Month)
and then (Day /= 29 or else Month /= 2 or else not Is_Leap (Year))
then
raise Time_Error;
end if;
-- Start accumulating nanoseconds from the low bound of Ada time.
-- Note: This starting point includes the lower buffer dedicated
-- to time zones.
Result_N := Ada_Low;
-- Step 2: Year processing and centenial year adjustment. Determine
-- the number of four year segments since the start of Ada time and
-- the input date.
Count := (Year - Year_Number'First) / 4;
Result_N := Result_N + Time (Count) * Secs_In_Four_Years * Nano;
-- Note that non-leap centenial years are automatically considered
-- leap in the operation above. An adjustment of several days is
-- required to compensate for this.
if Year > 2300 then
Result_N := Result_N - Time (3) * Nanos_In_Day;
elsif Year > 2200 then
Result_N := Result_N - Time (2) * Nanos_In_Day;
Leap_Second_Times (J) := elsif Year > 2100 then
Time (Days * Duration (86_400.0) + Duration (J - 1)); Result_N := Result_N - Time (1) * Nanos_In_Day;
end if;
-- Add the remaining non-leap years
Count := (Year - Year_Number'First) mod 4;
Result_N := Result_N + Time (Count) * Secs_In_Non_Leap_Year * Nano;
-- Step 3: Day of month processing. Determine the number of days
-- since the start of the current year. Do not add the current
-- day since it has not elapsed yet.
Count := Cumulative_Days_Before_Month (Month) + Day - 1;
-- The input year is leap and we have passed February
-- Add one to get to the leap second. Add J - 1 previous if Is_Leap (Year)
-- leap seconds. and then Month > 2
then
Count := Count + 1;
end if;
Result_N := Result_N + Time (Count) * Nanos_In_Day;
-- Step 4: Hour, minute, second and sub second processing
if Use_Day_Secs then
Result_N := Result_N + To_Abs_Time (Day_Secs);
else
Result_N := Result_N +
Time (Hour * 3_600 + Minute * 60 + Second) * Nano;
if Sub_Sec = 1.0 then
Result_N := Result_N + Time (1) * Nano;
else
Result_N := Result_N + To_Abs_Time (Sub_Sec);
end if;
end if;
-- Step 4: Time zone processing. At this point we have built an
-- arbitrary time value which is not related to any time zone.
-- For simplicity, the time value is normalized to GMT, producing
-- a uniform representation which can be treated by arithmetic
-- operations for instance without any additional corrections.
if Result_N < Ada_Low
or else Result_N > Ada_High
then
raise Time_Error;
end if;
if Time_Zone /= 0 then
Abs_Time_Zone := Time (abs (Time_Zone)) * 60 * Nano;
if Time_Zone < 0 then
Result_N := Result_N + Abs_Time_Zone;
else
-- The following test is obsolete since the result already
-- contains the dedicated buffer for time zones, thus no
-- error will be raised. However it is a good idea to keep
-- this comparison should the representation of time change.
if Result_N < Abs_Time_Zone then
raise Time_Error;
end if;
Result_N := Result_N - Abs_Time_Zone;
end if;
end if;
-- Step 5: Leap seconds processing in GMT
Cumulative_Leap_Seconds
(Time_Zero, Result_N, Elapsed_Leaps, Next_Leap_N);
Result_N := Result_N + Time (Elapsed_Leaps) * Nano;
-- An Ada 2005 caller requesting an explicit leap second or an Ada
-- 95 caller accounting for an invisible leap second.
Rounded_Result_N := Result_N - (Result_N mod Nano);
if Leap_Sec
or else Rounded_Result_N = Next_Leap_N
then
Result_N := Result_N + Time (1) * Nano;
Rounded_Result_N := Rounded_Result_N + Time (1) * Nano;
end if;
-- Leap second validity check
if Leap_Checks
and then Leap_Sec
and then Rounded_Result_N /= Next_Leap_N
then
raise Time_Error;
end if;
-- Final bounds check
if Result_N < Hard_Ada_Low
or else Result_N > Hard_Ada_High_And_Leaps
then
raise Time_Error;
end if;
return Result_N;
end Time_Of;
end Formatting_Operations;
---------------------------
-- Time_Zones_Operations --
---------------------------
package body Time_Zones_Operations is
-- The Unix time bounds in seconds: 1970/1/1 .. 2037/1/1
Unix_Min : constant Time :=
Time (17 * 366 + 52 * 365 + 2) * Secs_In_Day;
-- 1970/1/1
Unix_Max : constant Time :=
Time (34 * 366 + 102 * 365 + 2) * Secs_In_Day +
Time (Leap_Seconds_Count);
-- 2037/1/1
-- The following constants denote February 28 during non-leap
-- centenial years, the units are nanoseconds.
T_2100_2_28 : constant Time :=
(Time (49 * 366 + 150 * 365 + 59 + 2) * Secs_In_Day +
Time (Leap_Seconds_Count)) * Nano;
T_2200_2_28 : constant Time :=
(Time (73 * 366 + 226 * 365 + 59 + 2) * Secs_In_Day +
Time (Leap_Seconds_Count)) * Nano;
T_2300_2_28 : constant Time :=
(Time (97 * 366 + 302 * 365 + 59 + 2) * Secs_In_Day +
Time (Leap_Seconds_Count)) * Nano;
-- 56 years (14 leap years + 42 non leap years) in seconds:
Secs_In_56_Years : constant := (14 * 366 + 42 * 365) * Secs_In_Day;
-- Base C types. There is no point dragging in Interfaces.C just for
-- these four types.
type char_Pointer is access Character;
subtype int is Integer;
subtype long is Long_Integer;
type long_Pointer is access all long;
-- The Ada equivalent of struct tm and type time_t
type tm is record
tm_sec : int; -- seconds after the minute (0 .. 60)
tm_min : int; -- minutes after the hour (0 .. 59)
tm_hour : int; -- hours since midnight (0 .. 24)
tm_mday : int; -- day of the month (1 .. 31)
tm_mon : int; -- months since January (0 .. 11)
tm_year : int; -- years since 1900
tm_wday : int; -- days since Sunday (0 .. 6)
tm_yday : int; -- days since January 1 (0 .. 365)
tm_isdst : int; -- Daylight Savings Time flag (-1 .. 1)
tm_gmtoff : long; -- offset from UTC in seconds
tm_zone : char_Pointer; -- timezone abbreviation
end record;
type tm_Pointer is access all tm;
subtype time_t is long;
type time_t_Pointer is access all time_t;
procedure localtime_tzoff
(C : time_t_Pointer;
res : tm_Pointer;
off : long_Pointer);
pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
-- This is a lightweight wrapper around the system library function
-- localtime_r. Parameter 'off' captures the UTC offset which is either
-- retrieved from the tm struct or calculated from the 'timezone' extern
-- and the tm_isdst flag in the tm struct.
---------------------
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time) return Long_Integer is
Adj_Cent : Integer := 0;
Adj_Date_N : Time;
Adj_Date_S : Time;
Offset : aliased long;
Secs_T : aliased time_t;
Secs_TM : aliased tm;
begin
Adj_Date_N := Date;
-- Dates which are 56 years appart fall on the same day, day light
-- saving and so on. Non-leap centenial years violate this rule by
-- one day and as a consequence, special adjustment is needed.
if Adj_Date_N > T_2100_2_28 then
if Adj_Date_N > T_2200_2_28 then
if Adj_Date_N > T_2300_2_28 then
Adj_Cent := 3;
else
Adj_Cent := 2;
end if;
else
Adj_Cent := 1;
end if;
end if;
if Adj_Cent > 0 then
Adj_Date_N := Adj_Date_N - Time (Adj_Cent) * Nanos_In_Day;
end if;
-- Convert to seconds and shift date within bounds of Unix time
Adj_Date_S := Adj_Date_N / Nano;
while Adj_Date_S < Unix_Min loop
Adj_Date_S := Adj_Date_S + Secs_In_56_Years;
end loop;
while Adj_Date_S >= Unix_Max loop
Adj_Date_S := Adj_Date_S - Secs_In_56_Years;
end loop; end loop;
end;
end Leap_Sec_Ops; -- Perform a shift in origins from Ada to Unix
Adj_Date_S := Adj_Date_S - Unix_Min;
Secs_T := time_t (Adj_Date_S);
localtime_tzoff
(Secs_T'Unchecked_Access,
Secs_TM'Unchecked_Access,
Offset'Unchecked_Access);
return Offset;
end UTC_Time_Offset;
end Time_Zones_Operations;
-- Start of elaboration code for Ada.Calendar
begin begin
System.OS_Primitives.Initialize; System.OS_Primitives.Initialize;
-- Population of the leap seconds table
declare
type Leap_Second_Date is record
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
end record;
Leap_Second_Dates :
constant array (1 .. Leap_Seconds_Count) of Leap_Second_Date :=
((1972, 6, 30), (1972, 12, 31), (1973, 12, 31), (1974, 12, 31),
(1975, 12, 31), (1976, 12, 31), (1977, 12, 31), (1978, 12, 31),
(1979, 12, 31), (1981, 6, 30), (1982, 6, 30), (1983, 6, 30),
(1985, 6, 30), (1987, 12, 31), (1989, 12, 31), (1990, 12, 31),
(1992, 6, 30), (1993, 6, 30), (1994, 6, 30), (1995, 12, 31),
(1997, 6, 30), (1998, 12, 31), (2005, 12, 31));
Days_In_Four_Years : constant := 365 * 3 + 366;
Days : Natural;
Leap : Leap_Second_Date;
Years : Natural;
begin
for Index in 1 .. Leap_Seconds_Count loop
Leap := Leap_Second_Dates (Index);
-- Calculate the number of days from the start of Ada time until
-- the current leap second occurence. Non-leap centenial years
-- are not accounted for in these calculations since there are
-- no leap seconds after 2100 yet.
Years := Leap.Year - Ada_Min_Year;
Days := (Years / 4) * Days_In_Four_Years;
Years := Years mod 4;
if Years = 1 then
Days := Days + 365;
elsif Years = 2 then
Days := Days + 365 * 2;
elsif Years = 3 then
Days := Days + 365 * 3;
end if;
Days := Days + Cumulative_Days_Before_Month (Leap.Month);
if Is_Leap (Leap.Year)
and then Leap.Month > 2
then
Days := Days + 1;
end if;
Days := Days + Leap.Day;
-- Index - 1 previous leap seconds are added to Time (Index) as
-- well as the lower buffer for time zones.
Leap_Second_Times (Index) := Ada_Low +
(Time (Days) * Secs_In_Day + Time (Index - 1)) * Nano;
end loop;
end;
end Ada.Calendar; end Ada.Calendar;
gcc/ada/a-calend.ads
...@@ -43,13 +43,17 @@ package Ada.Calendar is ...@@ -43,13 +43,17 @@ package Ada.Calendar is
-- these do NOT constrain the possible stored values of time which may well -- 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). -- 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 Month_Number is Integer range 1 .. 12;
subtype Day_Number is Integer range 1 .. 31; 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; subtype Day_Duration is Duration range 0.0 .. 86_400.0;
function Clock return Time; 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 Year (Date : Time) return Year_Number;
function Month (Date : Time) return Month_Number; function Month (Date : Time) return Month_Number;
...@@ -62,6 +66,10 @@ package Ada.Calendar is ...@@ -62,6 +66,10 @@ package Ada.Calendar is
Month : out Month_Number; Month : out Month_Number;
Day : out Day_Number; Day : out Day_Number;
Seconds : out Day_Duration); 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 function Time_Of
(Year : Year_Number; (Year : Year_Number;
...@@ -87,6 +95,10 @@ package Ada.Calendar is ...@@ -87,6 +95,10 @@ package Ada.Calendar is
function "+" (Left : Duration; Right : Time) return Time; function "+" (Left : Duration; Right : Time) return Time;
function "-" (Left : Time; Right : Duration) return Time; function "-" (Left : Time; Right : Duration) return Time;
function "-" (Left : Time; Right : Time) return Duration; 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;
function "<=" (Left, Right : Time) return Boolean; function "<=" (Left, Right : Time) return Boolean;
...@@ -110,83 +122,183 @@ private ...@@ -110,83 +122,183 @@ private
pragma Inline (">"); pragma Inline (">");
pragma Inline (">="); pragma Inline (">=");
-- Time is represented as a signed duration from the base point which is -- The units used in this version of Ada.Calendar are nanoseconds. The
-- what Unix calls the EPOCH (i.e. 12 midnight (24:00:00), Dec 31st, 1969, -- following constants provide values used in conversions of seconds or
-- or if you prefer 0:00:00 on Jan 1st, 1970). Since Ada allows dates -- days to the underlying units.
-- before this EPOCH value, the stored duration value may be negative.
Nano : constant := 1_000_000_000;
-- The time value stored is typically a GMT value, as provided in standard Nano_F : constant := 1_000_000_000.0;
-- Unix environments. If this is the case then Split and Time_Of perform Nanos_In_Day : constant := 86_400_000_000_000;
-- required conversions to and from local times. The range of times that Secs_In_Day : constant := 86_400;
-- 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 -- Implementation of Time --
-- 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. -- 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
type Time is new Duration; -- by Time_Of are internaly normalized to GMT regardless of their local
-- time zone. This representation ensures correct handling of leap seconds
-- The following package provides handling of leap seconds. It is -- as well as performing arithmetic. In Ada 95, Split will treat a time
-- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both -- value as being in the local time zone and break it down accordingly.
-- Ada 2005 children of Ada.Calendar. -- 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.
package Leap_Sec_Ops is -- 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).
After_Last_Leap : constant Time := Time'Last;
-- Bigger by far than any leap second value. Not within range of ------------------
-- Ada.Calendar specified dates. -- Leap seconds --
------------------
procedure Cumulative_Leap_Secs
(Start_Date : Time; -- Due to Earth's slowdown, the astronomical time is not as precise as the
End_Date : Time; -- International Atomic Time. To compensate for this inaccuracy, a single
Leaps_Between : out Duration; -- leap second is added after the last day of June or December. The count
Next_Leap_Sec : out Time); -- of seconds during those occurences becomes:
-- Leaps_Between is the sum of the leap seconds that have occured
-- on or after Start_Date and before (strictly before) End_Date. -- ... 58, 59, leap second 60, 1, 2 ...
-- Next_Leap_Sec represents the next leap second occurence on or
-- after End_Date. If there are no leaps seconds after End_Date, -- Unlike leap days, leap seconds occur simultaneously around the world.
-- After_Last_Leap is returned. This does not provide info about -- In other words, if a leap second occurs at 23:59:60 GMT, it also occurs
-- the next leap second (pos/neg or ?). After_Last_Leap can be used -- on 18:59:60 -5 or 2:59:60 +2 on the next day.
-- as End_Date to count all the leap seconds that have occured on -- Leap seconds do not follow a formula. The International Earth Rotation
-- or after Start_Date. -- 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,
-- Important Notes: any fractional parts of Start_Date and End_Date -- the following two time values will conceptually differ by two seconds:
-- 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 -- Time_Of (1972, 7, 1, 0.0) - Time_Of (1972, 6, 30, 86_399.0) = 2 secs
-- 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 -- When a new leap second is added, the following steps must be carried
-- the caller wants to know if the End_Date is a leap second, the -- out:
-- comparison should be:
-- -- 1) Increment Leap_Seconds_Count by one
-- End_Date >= Next_Leap_Sec; -- 2) Add an entry to the end of table Leap_Second_Dates
--
-- After_Last_Leap is designed so that this comparison works without -- The algorithms that build the actual leap second values and discover
-- having to first check if Next_Leap_Sec is a valid leap second. -- how many leap seconds have occured between two dates do not need any
-- modification.
function All_Leap_Seconds return Duration;
-- Returns the sum off all of the leap seoncds. ------------------------------
-- Non-leap centenial years --
end Leap_Sec_Ops; ------------------------------
procedure Split_With_Offset -- Over the range of Ada time, centenial years 2100, 2200 and 2300 are
(Date : Time; -- non-leap. As a consequence, seven non-leap years occur over the period
Year : out Year_Number; -- of year - 4 to year + 4. Internaly, routines Split and Time_Of add or
Month : out Month_Number; -- subtract a "fake" February 29 to facilitate the arithmetic involved.
Day : out Day_Number; -- This small "cheat" remains hidden and the following calculations do
Seconds : out Day_Duration; -- produce the correct difference.
Offset : out Long_Integer);
-- Split_W_Offset has the same spec as Split with the addition of an -- Time_Of (2100, 3, 1, 0.0) - Time_Of (2100, 2, 28, 0.0) = 1 day
-- offset value which give the offset of the local time zone from UTC -- Time_Of (2101, 1, 1, 0.0) - Time_Of (2100, 12, 31, 0.0) = 1 day
-- 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 type Time_Rep is mod 2 ** 64;
-- is straight from the C tm struct and is in seconds. If the system type Time is new Time_Rep;
-- 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 -- Due to boundary time values and time zones, two days of buffer space
-- it is up to the user to check both for Invalid_TZ_Offset and otherwise -- are set aside at both end points of Ada time:
-- for a value that is acceptable.
-- Abs zero Hard low Soft low Soft high Hard high
Invalid_TZ_Offset : Long_Integer; -- +---------+============+#################+============+----------->
pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff"); -- Buffer 1 Real Ada time Buffer 2
-- A time value in a any time zone may not excede the hard bounds of Ada
-- time, while a value in GMT may not go over the soft bounds.
Buffer_D : constant Duration := 2.0 * Secs_In_Day;
Buffer_N : constant Time := 2 * Nanos_In_Day;
-- Lower and upper bound of Ada time shifted by two days from the absolute
-- zero. Note that the upper bound includes the non-leap centenial years.
Ada_Low : constant Time := Buffer_N;
Ada_High : constant Time := (121 * 366 + 378 * 365) * Nanos_In_Day +
Buffer_N;
-- Both of these hard bounds are 28 hours before and after their regular
-- counterpart. The value of 28 is taken from Ada.Calendar.Time_Zones.
Hard_Ada_Low : constant Time := Ada_Low - 100_800 * Nano;
Hard_Ada_High : constant Time := Ada_High + 100_800 * Nano;
Days_In_Month : constant array (Month_Number) of Day_Number :=
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
Invalid_Time_Zone_Offset : Long_Integer;
pragma Import (C, Invalid_Time_Zone_Offset, "__gnat_invalid_tzoff");
function Is_Leap (Year : Year_Number) return Boolean;
-- Determine whether a given year is leap
-- The following packages provide a target independent interface to the
-- children of Calendar - Arithmetic, Delays, Formatting and Time_Zones.
package Arithmetic_Operations is
function Add (Date : Time; Days : Long_Integer) return Time;
-- Add X number of days to a time value
procedure Difference
(Left : Time;
Right : Time;
Days : out Long_Integer;
Seconds : out Duration;
Leap_Seconds : out Integer);
-- Calculate the difference between two time values in terms of days,
-- seconds and leap seconds elapsed. The leap seconds are not included
-- in the seconds returned. If Left is greater than Right, the returned
-- values are positive, negative otherwise.
function Subtract (Date : Time; Days : Long_Integer) return Time;
-- Subtract X number of days from a time value
end Arithmetic_Operations;
package Delays_Operations is
function To_Duration (Ada_Time : Time) return Duration;
-- Given a time value in nanoseconds since 1901, convert it into a
-- duration value giving the number of nanoseconds since the Unix Epoch.
end Delays_Operations;
package Formatting_Operations is
function Day_Of_Week (Date : Time) return Integer;
-- Determine which day of week Date falls on. The returned values are
-- within the range of 0 .. 6 (Monday .. Sunday).
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Day_Secs : out Day_Duration;
Hour : out Integer;
Minute : out Integer;
Second : out Integer;
Sub_Sec : out Duration;
Leap_Sec : out Boolean;
Time_Zone : Long_Integer);
-- Split a time value into its components
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Day_Secs : Day_Duration;
Hour : Integer;
Minute : Integer;
Second : Integer;
Sub_Sec : Duration;
Leap_Sec : Boolean;
Leap_Checks : Boolean;
Use_Day_Secs : Boolean;
Time_Zone : Long_Integer) return Time;
-- Given all the components of a date, return the corresponding time
-- value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the
-- day duration will be calculated from Hour, Minute, Second and Sub_
-- Sec. Set flag Leap_Checks to verify the validity of a leap second.
end Formatting_Operations;
package Time_Zones_Operations is
function UTC_Time_Offset (Date : Time) return Long_Integer;
-- Return the offset in seconds from GMT
end Time_Zones_Operations;
end Ada.Calendar; end Ada.Calendar;
gcc/ada/a-calfor.adb
...@@ -33,33 +33,15 @@ ...@@ -33,33 +33,15 @@
with Ada.Calendar; use Ada.Calendar; with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones; with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
with Unchecked_Conversion;
package body Ada.Calendar.Formatting is package body Ada.Calendar.Formatting is
use Leap_Sec_Ops; --------------------------
-- Implementation Notes --
--------------------------
Days_In_4_Years : constant := 365 * 3 + 366; -- All operations in this package are target and time representation
Seconds_In_Day : constant := 86_400; -- independent, thus only one source file is needed for multiple targets.
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);
procedure Check_Char (S : String; C : Character; Index : Integer); procedure Check_Char (S : String; C : Character; Index : Integer);
-- Subsidiary to the two versions of Value. Determine whether the -- Subsidiary to the two versions of Value. Determine whether the
...@@ -102,19 +84,18 @@ package body Ada.Calendar.Formatting is ...@@ -102,19 +84,18 @@ package body Ada.Calendar.Formatting is
(Date : Time; (Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
is is
Year : Year_Number; Y : Year_Number;
Month : Month_Number; Mo : Month_Number;
Day : Day_Number; D : Day_Number;
Hour : Hour_Number; H : Hour_Number;
Minute : Minute_Number; Mi : Minute_Number;
Second : Second_Number; Se : Second_Number;
Sub_Second : Second_Duration; Ss : Second_Duration;
Leap_Second : Boolean; Le : Boolean;
begin begin
Split (Date, Year, Month, Day, Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); return D;
return Day;
end Day; end Day;
----------------- -----------------
...@@ -122,51 +103,8 @@ package body Ada.Calendar.Formatting is ...@@ -122,51 +103,8 @@ package body Ada.Calendar.Formatting is
----------------- -----------------
function Day_Of_Week (Date : Time) return Day_Name 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 begin
-- Split the Date to obtain the year, month and day, then build a time return Day_Name'Val (Formatting_Operations.Day_Of_Week (Date));
-- 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);
end Day_Of_Week; end Day_Of_Week;
---------- ----------
...@@ -177,19 +115,18 @@ package body Ada.Calendar.Formatting is ...@@ -177,19 +115,18 @@ package body Ada.Calendar.Formatting is
(Date : Time; (Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
is is
Year : Year_Number; Y : Year_Number;
Month : Month_Number; Mo : Month_Number;
Day : Day_Number; D : Day_Number;
Hour : Hour_Number; H : Hour_Number;
Minute : Minute_Number; Mi : Minute_Number;
Second : Second_Number; Se : Second_Number;
Sub_Second : Second_Duration; Ss : Second_Duration;
Leap_Second : Boolean; Le : Boolean;
begin begin
Split (Date, Year, Month, Day, Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); return H;
return Hour;
end Hour; end Hour;
----------- -----------
...@@ -377,19 +314,17 @@ package body Ada.Calendar.Formatting is ...@@ -377,19 +314,17 @@ package body Ada.Calendar.Formatting is
(Date : Time; (Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
is is
Year : Year_Number; Y : Year_Number;
Month : Month_Number; Mo : Month_Number;
Day : Day_Number; D : Day_Number;
Hour : Hour_Number; H : Hour_Number;
Minute : Minute_Number; Mi : Minute_Number;
Second : Second_Number; Se : Second_Number;
Sub_Second : Second_Duration; Ss : Second_Duration;
Leap_Second : Boolean; Le : Boolean;
begin begin
Split (Date, Year, Month, Day, Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); return Mi;
return Minute;
end Minute; end Minute;
----------- -----------
...@@ -400,19 +335,17 @@ package body Ada.Calendar.Formatting is ...@@ -400,19 +335,17 @@ package body Ada.Calendar.Formatting is
(Date : Time; (Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
is is
Year : Year_Number; Y : Year_Number;
Month : Month_Number; Mo : Month_Number;
Day : Day_Number; D : Day_Number;
Hour : Hour_Number; H : Hour_Number;
Minute : Minute_Number; Mi : Minute_Number;
Second : Second_Number; Se : Second_Number;
Sub_Second : Second_Duration; Ss : Second_Duration;
Leap_Second : Boolean; Le : Boolean;
begin begin
Split (Date, Year, Month, Day, Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); return Mo;
return Month;
end Month; end Month;
------------ ------------
...@@ -420,19 +353,17 @@ package body Ada.Calendar.Formatting is ...@@ -420,19 +353,17 @@ package body Ada.Calendar.Formatting is
------------ ------------
function Second (Date : Time) return Second_Number is function Second (Date : Time) return Second_Number is
Year : Year_Number; Y : Year_Number;
Month : Month_Number; Mo : Month_Number;
Day : Day_Number; D : Day_Number;
Hour : Hour_Number; H : Hour_Number;
Minute : Minute_Number; Mi : Minute_Number;
Second : Second_Number; Se : Second_Number;
Sub_Second : Second_Duration; Ss : Second_Duration;
Leap_Second : Boolean; Le : Boolean;
begin begin
Split (Date, Year, Month, Day, Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
Hour, Minute, Second, Sub_Second, Leap_Second); return Se;
return Second;
end Second; end Second;
---------------- ----------------
...@@ -456,9 +387,9 @@ package body Ada.Calendar.Formatting is ...@@ -456,9 +387,9 @@ package body Ada.Calendar.Formatting is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
return Day_Duration (Hour * 3600) + return Day_Duration (Hour * 3_600) +
Day_Duration (Minute * 60) + Day_Duration (Minute * 60) +
Day_Duration (Second) + Day_Duration (Second) +
Sub_Second; Sub_Second;
end Seconds_Of; end Seconds_Of;
...@@ -489,10 +420,20 @@ package body Ada.Calendar.Formatting is ...@@ -489,10 +420,20 @@ package body Ada.Calendar.Formatting is
end if; end if;
Sub_Second := Second_Duration (Seconds - Day_Duration (Secs)); Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
Hour := Hour_Number (Secs / 3600); Hour := Hour_Number (Secs / 3_600);
Secs := Secs mod 3600; Secs := Secs mod 3_600;
Minute := Minute_Number (Secs / 60); Minute := Minute_Number (Secs / 60);
Second := Second_Number (Secs mod 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; end Split;
----------- -----------
...@@ -508,16 +449,25 @@ package body Ada.Calendar.Formatting is ...@@ -508,16 +449,25 @@ package body Ada.Calendar.Formatting is
Leap_Second : out Boolean; Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0) Time_Zone : Time_Zones.Time_Offset := 0)
is is
Hour : Hour_Number; H : Integer;
Minute : Minute_Number; M : Integer;
Second : Second_Number; Se : Integer;
Sub_Second : Second_Duration; Su : Duration;
Tz : constant Long_Integer := Long_Integer (Time_Zone);
begin begin
Split (Date, Year, Month, Day, Formatting_Operations.Split
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); (Date, Year, Month, Day, Seconds, H, M, Se, Su, Leap_Second, Tz);
-- Validity checks
Seconds := Seconds_Of (Hour, Minute, Second, Sub_Second); if not Year'Valid
or else not Month'Valid
or else not Day'Valid
or else not Seconds'Valid
then
raise Time_Error;
end if;
end Split; end Split;
----------- -----------
...@@ -535,11 +485,27 @@ package body Ada.Calendar.Formatting is ...@@ -535,11 +485,27 @@ package body Ada.Calendar.Formatting is
Sub_Second : out Second_Duration; Sub_Second : out Second_Duration;
Time_Zone : Time_Zones.Time_Offset := 0) Time_Zone : Time_Zones.Time_Offset := 0)
is is
Leap_Second : Boolean; Dd : Day_Duration;
Le : Boolean;
Tz : constant Long_Integer := Long_Integer (Time_Zone);
begin begin
Split (Date, Year, Month, Day, Formatting_Operations.Split
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); (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; end Split;
----------- -----------
...@@ -558,139 +524,26 @@ package body Ada.Calendar.Formatting is ...@@ -558,139 +524,26 @@ package body Ada.Calendar.Formatting is
Leap_Second : out Boolean; Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0) Time_Zone : Time_Zones.Time_Offset := 0)
is is
Ada_Year_Min : constant Year_Number := Year_Number'First; Dd : Day_Duration;
Day_In_Year : Integer; Tz : constant Long_Integer := Long_Integer (Time_Zone);
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;
begin begin
-- Our measurement of time is the number of seconds that have elapsed Formatting_Operations.Split
-- since the Unix TOE. To calculate a UTC date from this we do a (Date, Year, Month, Day, Dd,
-- sequence of divides and mods to get the components of a date based Hour, Minute, Second, Sub_Second, Leap_Second, Tz);
-- 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;
-- Step 2: Process the time zone -- Validity checks
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.
if Modified_Date < Start_Of_Time if not Year'Valid
or else Modified_Date >= (End_Of_Time - All_Leap_Seconds) 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 then
raise Time_Error; raise Time_Error;
end if; 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; end Split;
---------------- ----------------
...@@ -698,20 +551,17 @@ package body Ada.Calendar.Formatting is ...@@ -698,20 +551,17 @@ package body Ada.Calendar.Formatting is
---------------- ----------------
function Sub_Second (Date : Time) return Second_Duration is function Sub_Second (Date : Time) return Second_Duration is
Year : Year_Number; Y : Year_Number;
Month : Month_Number; Mo : Month_Number;
Day : Day_Number; D : Day_Number;
Hour : Hour_Number; H : Hour_Number;
Minute : Minute_Number; Mi : Minute_Number;
Second : Second_Number; Se : Second_Number;
Sub_Second : Second_Duration; Ss : Second_Duration;
Leap_Second : Boolean; Le : Boolean;
begin begin
Split (Date, Year, Month, Day, Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
Hour, Minute, Second, Sub_Second, Leap_Second); return Ss;
return Sub_Second;
end Sub_Second; end Sub_Second;
------------- -------------
...@@ -726,79 +576,56 @@ package body Ada.Calendar.Formatting is ...@@ -726,79 +576,56 @@ package body Ada.Calendar.Formatting is
Leap_Second : Boolean := False; Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time Time_Zone : Time_Zones.Time_Offset := 0) return Time
is is
Hour : Hour_Number; Adj_Year : Year_Number := Year;
Minute : Minute_Number; Adj_Month : Month_Number := Month;
Sec_Num : Second_Number; Adj_Day : Day_Number := Day;
Sub_Sec : Second_Duration;
Whole_Part : Integer; 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 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; raise Constraint_Error;
end if; end if;
-- The fact that Seconds can go to 86,400 creates all this extra work. -- A Seconds value of 86_400 denotes a new day. This case requires an
-- Perhaps a Time_Of just like the next one but allowing the Second_ -- adjustment to the input values.
-- 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;
if Seconds = 86_400.0 then if Seconds = 86_400.0 then
declare if Day < Days_In_Month (Month)
Adj_Year : Year_Number := Year; or else (Is_Leap (Year)
Adj_Month : Month_Number := Month; and then Month = 2)
Adj_Day : Day_Number := Day; then
Adj_Day := Day + 1;
begin else
Hour := 0; Adj_Day := 1;
Minute := 0;
Sec_Num := 0; if Month < 12 then
Sub_Sec := 0.0; Adj_Month := Month + 1;
if Day < Days_In_Month (Month)
or else (Month = 2
and then Year mod 4 = 0)
then
Adj_Day := Day + 1;
else else
Adj_Day := 1; Adj_Month := 1;
Adj_Year := Year + 1;
if Month < 12 then
Adj_Month := Month + 1;
else
Adj_Month := 1;
Adj_Year := Year + 1;
end if;
end if; 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; end if;
declare return
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1; Formatting_Operations.Time_Of
for D_Int'Size use Duration'Size; (Adj_Year, Adj_Month, Adj_Day, Seconds, H, M, Se, Ss,
Leap_Sec => Leap_Second,
function To_D_Int is new Unchecked_Conversion (Duration, D_Int); Leap_Checks => True,
function To_Duration is new Unchecked_Conversion (D_Int, Duration); Use_Day_Secs => True,
Time_Zone => Tz);
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);
end Time_Of; end Time_Of;
------------- -------------
...@@ -816,23 +643,11 @@ package body Ada.Calendar.Formatting is ...@@ -816,23 +643,11 @@ package body Ada.Calendar.Formatting is
Leap_Second : Boolean := False; Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time Time_Zone : Time_Zones.Time_Offset := 0) return Time
is is
Cumulative_Days_Before_Month : Dd : constant Day_Duration := Day_Duration'First;
constant array (Month_Number) of Natural := Tz : constant Long_Integer := Long_Integer (Time_Zone);
(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;
begin begin
-- The following checks are redundant with respect to the constraint -- Validity checks
-- 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 if not Year'Valid
or else not Month'Valid or else not Month'Valid
...@@ -846,99 +661,13 @@ package body Ada.Calendar.Formatting is ...@@ -846,99 +661,13 @@ package body Ada.Calendar.Formatting is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
-- Start the accumulation from the beginning of Ada time return
Formatting_Operations.Time_Of
Result := Start_Of_Time; (Year, Month, Day, Dd, Hour, Minute, Second, Sub_Second,
Leap_Sec => Leap_Second,
-- Step 1: Determine the number of leap and non-leap years since 1901 Leap_Checks => True,
-- and the input date. Use_Day_Secs => False,
Time_Zone => Tz);
-- 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;
end Time_Of; end Time_Of;
----------- -----------
...@@ -1117,19 +846,18 @@ package body Ada.Calendar.Formatting is ...@@ -1117,19 +846,18 @@ package body Ada.Calendar.Formatting is
(Date : Time; (Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
is is
Year : Year_Number; Y : Year_Number;
Month : Month_Number; Mo : Month_Number;
Day : Day_Number; D : Day_Number;
Hour : Hour_Number; H : Hour_Number;
Minute : Minute_Number; Mi : Minute_Number;
Second : Second_Number; Se : Second_Number;
Sub_Second : Second_Duration; Ss : Second_Duration;
Leap_Second : Boolean; Le : Boolean;
begin begin
Split (Date, Year, Month, Day, Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); return Y;
return Year;
end Year; end Year;
end Ada.Calendar.Formatting; end Ada.Calendar.Formatting;
gcc/ada/a-calfor.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -35,6 +35,10 @@ ...@@ -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; with Ada.Calendar.Time_Zones;
package Ada.Calendar.Formatting is package Ada.Calendar.Formatting is
...@@ -84,6 +88,12 @@ package Ada.Calendar.Formatting is ...@@ -84,6 +88,12 @@ package Ada.Calendar.Formatting is
Minute : Minute_Number; Minute : Minute_Number;
Second : Second_Number := 0; Second : Second_Number := 0;
Sub_Second : Second_Duration := 0.0) return Day_Duration; 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 procedure Split
(Seconds : Day_Duration; (Seconds : Day_Duration;
...@@ -91,6 +101,9 @@ package Ada.Calendar.Formatting is ...@@ -91,6 +101,9 @@ package Ada.Calendar.Formatting is
Minute : out Minute_Number; Minute : out Minute_Number;
Second : out Second_Number; Second : out Second_Number;
Sub_Second : out Second_Duration); 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 procedure Split
(Date : Time; (Date : Time;
...@@ -102,6 +115,9 @@ package Ada.Calendar.Formatting is ...@@ -102,6 +115,9 @@ package Ada.Calendar.Formatting is
Second : out Second_Number; Second : out Second_Number;
Sub_Second : out Second_Duration; Sub_Second : out Second_Duration;
Time_Zone : Time_Zones.Time_Offset := 0); 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 function Time_Of
(Year : Year_Number; (Year : Year_Number;
...@@ -113,6 +129,14 @@ package Ada.Calendar.Formatting is ...@@ -113,6 +129,14 @@ package Ada.Calendar.Formatting is
Sub_Second : Second_Duration := 0.0; Sub_Second : Second_Duration := 0.0;
Leap_Second : Boolean := False; Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time; 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 function Time_Of
(Year : Year_Number; (Year : Year_Number;
...@@ -121,6 +145,14 @@ package Ada.Calendar.Formatting is ...@@ -121,6 +145,14 @@ package Ada.Calendar.Formatting is
Seconds : Day_Duration := 0.0; Seconds : Day_Duration := 0.0;
Leap_Second : Boolean := False; Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time; 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 procedure Split
(Date : Time; (Date : Time;
...@@ -133,6 +165,14 @@ package Ada.Calendar.Formatting is ...@@ -133,6 +165,14 @@ package Ada.Calendar.Formatting is
Sub_Second : out Second_Duration; Sub_Second : out Second_Duration;
Leap_Second : out Boolean; Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0); 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 procedure Split
(Date : Time; (Date : Time;
...@@ -142,6 +182,14 @@ package Ada.Calendar.Formatting is ...@@ -142,6 +182,14 @@ package Ada.Calendar.Formatting is
Seconds : out Day_Duration; Seconds : out Day_Duration;
Leap_Second : out Boolean; Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0); 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 -- Simple image and value
...@@ -149,15 +197,39 @@ package Ada.Calendar.Formatting is ...@@ -149,15 +197,39 @@ package Ada.Calendar.Formatting is
(Date : Time; (Date : Time;
Include_Time_Fraction : Boolean := False; Include_Time_Fraction : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return String; 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 function Value
(Date : String; (Date : String;
Time_Zone : Time_Zones.Time_Offset := 0) return Time; 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 function Image
(Elapsed_Time : Duration; (Elapsed_Time : Duration;
Include_Time_Fraction : Boolean := False) return String; 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; 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; end Ada.Calendar.Formatting;
gcc/ada/a-catizo.adb
...@@ -33,35 +33,39 @@ ...@@ -33,35 +33,39 @@
package body Ada.Calendar.Time_Zones is 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 -- -- UTC_Time_Offset --
--------------------- ---------------------
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is
Year : Year_Number; Offset_L : constant Long_Integer :=
Month : Month_Number; Time_Zones_Operations.UTC_Time_Offset (Date);
Day : Day_Number; Offset : Time_Offset;
Seconds : Day_Duration;
Offset : Long_Integer;
begin begin
Split_With_Offset (Date, Year, Month, Day, Seconds, Offset); if Offset_L = Invalid_Time_Zone_Offset then
-- The system dependent code does not support time zones
if Offset = Invalid_TZ_Offset then
raise Unknown_Zone_Error; raise Unknown_Zone_Error;
end if; 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) if not Offset'Valid then
or else Offset > Long_Integer (Time_Offset'Last)
then
raise Unknown_Zone_Error; raise Unknown_Zone_Error;
end if; end if;
return Time_Offset (Offset); return Offset;
end UTC_Time_Offset; end UTC_Time_Offset;
end Ada.Calendar.Time_Zones; end Ada.Calendar.Time_Zones;
gcc/ada/a-catizo.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -35,6 +35,9 @@ ...@@ -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 package Ada.Calendar.Time_Zones is
-- Time zone manipulation -- Time zone manipulation
...@@ -44,5 +47,9 @@ package Ada.Calendar.Time_Zones is ...@@ -44,5 +47,9 @@ package Ada.Calendar.Time_Zones is
Unknown_Zone_Error : exception; Unknown_Zone_Error : exception;
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset; 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; end Ada.Calendar.Time_Zones;
gcc/ada/a-direct.adb
...@@ -31,10 +31,11 @@ ...@@ -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.Directories.Validity; use Ada.Directories.Validity;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with Ada.Unchecked_Conversion;
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
...@@ -46,13 +47,6 @@ with System; ...@@ -46,13 +47,6 @@ with System;
package body Ada.Directories is 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 type Search_Data is record
Is_Valid : Boolean := False; Is_Valid : Boolean := False;
Name : Ada.Strings.Unbounded.Unbounded_String; Name : Ada.Strings.Unbounded.Unbounded_String;
...@@ -724,7 +718,7 @@ package body Ada.Directories is ...@@ -724,7 +718,7 @@ package body Ada.Directories is
-- Modification_Time -- -- Modification_Time --
----------------------- -----------------------
function Modification_Time (Name : String) return Ada.Calendar.Time is function Modification_Time (Name : String) return Time is
Date : OS_Time; Date : OS_Time;
Year : Year_Type; Year : Year_Type;
Month : Month_Type; Month : Month_Type;
...@@ -732,8 +726,7 @@ package body Ada.Directories is ...@@ -732,8 +726,7 @@ package body Ada.Directories is
Hour : Hour_Type; Hour : Hour_Type;
Minute : Minute_Type; Minute : Minute_Type;
Second : Second_Type; Second : Second_Type;
Result : Time;
Result : Ada.Calendar.Time;
begin begin
-- First, the invalid cases -- First, the invalid cases
...@@ -744,26 +737,31 @@ package body Ada.Directories is ...@@ -744,26 +737,31 @@ package body Ada.Directories is
else else
Date := File_Time_Stamp (Name); Date := File_Time_Stamp (Name);
-- ??? This implementation should be revisited when AI 00351 has -- Break down the time stamp into its constituents relative to GMT.
-- implemented. -- 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 -- On Unix and Windows, the result must be in GMT. Ada.Calendar.
(Year, Month, Day, -- Formatting.Time_Of with default time zone of zero (0) is the
Duration (Second + 60 * (Minute + 60 * Hour))); -- routine of choice.
else else
-- On Unix and Windows, OS_Time is in GMT Result := Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0);
Result :=
Duration_To_Time (Duration (OS_Time_To_Long_Integer (Date)));
return Result;
end if; end if;
return Result;
end if; end if;
end Modification_Time; end Modification_Time;
......
gcc/ada/sysdep.c
...@@ -687,7 +687,7 @@ get_gmtoff (void) ...@@ -687,7 +687,7 @@ get_gmtoff (void)
/* This value is returned as the time zone offset when a valid value /* 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 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; long __gnat_invalid_tzoff = 259273;
...@@ -755,8 +755,9 @@ __gnat_localtime_tzoff (const time_t *, struct tm *, long *); ...@@ -755,8 +755,9 @@ __gnat_localtime_tzoff (const time_t *, struct tm *, long *);
struct tm * struct tm *
__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off) __gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
{ {
/* Treat all time values in GMT */
localtime_r (tp, timer); localtime_r (tp, timer);
*off = __gnat_invalid_tzoff; *off = 0;
return NULL; return NULL;
} }
...@@ -779,17 +780,60 @@ __gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off) ...@@ -779,17 +780,60 @@ __gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
/* AIX, HPUX, SGI Irix, Sun Solaris */ /* AIX, HPUX, SGI Irix, Sun Solaris */
#if defined (_AIX) || defined (__hpux__) || defined (sgi) || defined (sun) #if defined (_AIX) || defined (__hpux__) || defined (sgi) || defined (sun)
*off = (long) -timezone; /* The contents of external variable "timezone" may not always be
if (tp->tm_isdst > 0) initialized. Instead of returning an incorrect offset, treat the local
*off = *off + 3600; time zone as 0 (UTC). The value of 28 hours is the maximum valid offset
allowed by Ada.Calendar.Time_Zones. */
if ((timezone < -28 * 3600) || (timezone > 28 * 3600))
*off = 0;
else
{
*off = (long) -timezone;
if (tp->tm_isdst > 0)
*off = *off + 3600;
}
/* Lynx - Treat all time values in GMT */
#elif defined (__Lynx__)
*off = 0;
/* VxWorks */
#elif defined (__vxworks)
#include <stdlib.h>
{
/* Try to read the environment variable TIMEZONE. The variable may not have
been initialize, in that case return an offset of zero (0) for UTC. */
char *tz_str = getenv ("TIMEZONE");
/* Lynx, VXWorks */ if ((tz_str == NULL) || (*tz_str == '\0'))
#elif defined (__Lynx__) || defined (__vxworks) *off = 0;
*off = __gnat_invalid_tzoff; 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 */ /* Darwin, Free BSD, Linux, Tru64, where there exists a component tm_gmtoff
#else in struct tm */
#elif defined (__APPLE__) || defined (__FreeBSD__) || defined (linux) ||\
(defined (__alpha__) && defined (__osf__))
*off = tp->tm_gmtoff; *off = tp->tm_gmtoff;
/* All other platforms: Treat all time values in GMT */
#else
*off = 0;
#endif #endif
return NULL; return NULL;
} }
...@@ -797,3 +841,59 @@ __gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off) ...@@ -797,3 +841,59 @@ __gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
#endif #endif
#endif #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