with Ada.Unchecked_Conversion;
+with Interfaces.C;
+
with System.OS_Primitives;
package body Ada.Calendar is
new Ada.Unchecked_Conversion (Time_Rep, Duration);
-- Convert a time representation value into a duration value
+ function UTC_Time_Offset
+ (Date : Time;
+ Is_Historic : Boolean) return Long_Integer;
+ -- This routine acts as an Ada wrapper around __gnat_localtime_tzoff which
+ -- in turn utilizes various OS-dependent mechanisms to calculate the time
+ -- zone offset of a date. Formal parameter Date represents an arbitrary
+ -- time stamp, either in the past, now, or in the future. If the flag
+ -- Is_Historic is set, this routine would try to calculate to the best of
+ -- the OS's abilities the time zone offset that was or will be in effect
+ -- on Date. If the flag is set to False, the routine returns the current
+ -- time zone with Date effectively set to Clock.
+ --
+ -- NOTE: Targets which support localtime_r will aways return a historic
+ -- time zone even if flag Is_Historic is set to False because this is how
+ -- localtime_r operates.
+
-----------------
-- Local Types --
-----------------
Leap_Support : constant Boolean := (Flag = 1);
-- Flag to controls the usage of leap seconds in all Ada.Calendar routines
- Leap_Seconds_Count : constant Natural := 24;
+ Leap_Seconds_Count : constant Natural := 25;
---------------------
-- Local Constants --
Unix_Min : constant Time_Rep :=
Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
+ -- The Unix upper time bound expressed as nanoseconds since the start of
+ -- Ada time in UTC.
+
+ Unix_Max : constant Time_Rep :=
+ Ada_Low + Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day +
+ Time_Rep (Leap_Seconds_Count) * Nano;
+
Epoch_Offset : constant Time_Rep := (136 * 365 + 44 * 366) * Nanos_In_Day;
-- The difference between 2150-1-1 UTC and 1970-1-1 UTC expressed in
-- nanoseconds. Note that year 2100 is non-leap.
-4812566380000000000,
-4765132779000000000,
-4544207978000000000,
- -4449513577000000000);
+ -4449513577000000000,
+ -4339180776000000000);
---------
-- "+" --
Time_Zone => 0);
end Time_Of;
+ ---------------------
+ -- UTC_Time_Offset --
+ ---------------------
+
+ function UTC_Time_Offset
+ (Date : Time;
+ Is_Historic : Boolean) return Long_Integer
+ is
+ -- The following constants denote February 28 during non-leap centennial
+ -- years, the units are nanoseconds.
+
+ T_2100_2_28 : constant Time_Rep := Ada_Low +
+ (Time_Rep (49 * 366 + 150 * 365 + 59) * Secs_In_Day +
+ Time_Rep (Leap_Seconds_Count)) * Nano;
+
+ T_2200_2_28 : constant Time_Rep := Ada_Low +
+ (Time_Rep (73 * 366 + 226 * 365 + 59) * Secs_In_Day +
+ Time_Rep (Leap_Seconds_Count)) * Nano;
+
+ T_2300_2_28 : constant Time_Rep := Ada_Low +
+ (Time_Rep (97 * 366 + 302 * 365 + 59) * Secs_In_Day +
+ Time_Rep (Leap_Seconds_Count)) * Nano;
+
+ -- 56 years (14 leap years + 42 non-leap years) in nanoseconds:
+
+ Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day;
+
+ type int_Pointer is access all Interfaces.C.int;
+ type long_Pointer is access all Interfaces.C.long;
+
+ type time_t is
+ range -(2 ** (Standard'Address_Size - Integer'(1))) ..
+ +(2 ** (Standard'Address_Size - Integer'(1)) - 1);
+ type time_t_Pointer is access all time_t;
+
+ procedure localtime_tzoff
+ (timer : time_t_Pointer;
+ is_historic : int_Pointer;
+ off : long_Pointer);
+ pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
+ -- This routine is a interfacing wrapper around the library function
+ -- __gnat_localtime_tzoff. Parameter 'timer' represents a Unix-based
+ -- time equivalent of the input date. If flag 'is_historic' is set, this
+ -- routine would try to calculate to the best of the OS's abilities the
+ -- time zone offset that was or will be in effect on 'timer'. If the
+ -- flag is set to False, the routine returns the current time zone
+ -- regardless of what 'timer' designates. Parameter 'off' captures the
+ -- UTC offset of 'timer'.
+
+ Adj_Cent : Integer;
+ Date_N : Time_Rep;
+ Flag : aliased Interfaces.C.int;
+ Offset : aliased Interfaces.C.long;
+ Secs_T : aliased time_t;
+
+ -- Start of processing for UTC_Time_Offset
+
+ begin
+ Date_N := Time_Rep (Date);
+
+ -- Dates which are 56 years apart fall on the same day, day light saving
+ -- and so on. Non-leap centennial years violate this rule by one day and
+ -- as a consequence, special adjustment is needed.
+
+ Adj_Cent :=
+ (if Date_N <= T_2100_2_28 then 0
+ elsif Date_N <= T_2200_2_28 then 1
+ elsif Date_N <= T_2300_2_28 then 2
+ else 3);
+
+ if Adj_Cent > 0 then
+ Date_N := Date_N - Time_Rep (Adj_Cent) * Nanos_In_Day;
+ end if;
+
+ -- Shift the date within bounds of Unix time
+
+ while Date_N < Unix_Min loop
+ Date_N := Date_N + Nanos_In_56_Years;
+ end loop;
+
+ while Date_N >= Unix_Max loop
+ Date_N := Date_N - Nanos_In_56_Years;
+ end loop;
+
+ -- Perform a shift in origins from Ada to Unix
+
+ Date_N := Date_N - Unix_Min;
+
+ -- Convert the date into seconds
+
+ Secs_T := time_t (Date_N / Nano);
+
+ -- Determine whether to treat the input date as historical or not
+
+ Flag := (if Is_Historic then 1 else 0);
+
+ localtime_tzoff
+ (Secs_T'Unchecked_Access,
+ Flag'Unchecked_Access,
+ Offset'Unchecked_Access);
+
+ return Long_Integer (Offset);
+ end UTC_Time_Offset;
+
----------
-- Year --
----------
function Day_Of_Week (Date : Time) return Integer is
Date_N : constant Time_Rep := Time_Rep (Date);
- Time_Zone : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset (Date);
+ Time_Zone : constant Long_Integer := UTC_Time_Offset (Date, True);
Ada_Low_N : Time_Rep;
Day_Count : Long_Integer;
Day_Dur : Time_Dur;
else
declare
Off : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset (Time (Date_N));
+ UTC_Time_Offset (Time (Date_N), False);
+
begin
Date_N := Date_N + Time_Rep (Off) * Nano;
end;
else
declare
Current_Off : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset
- (Time (Res_N));
+ UTC_Time_Offset (Time (Res_N), False);
Current_Res_N : constant Time_Rep :=
Res_N - Time_Rep (Current_Off) * Nano;
Off : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset
- (Time (Current_Res_N));
+ UTC_Time_Offset (Time (Current_Res_N), False);
+
begin
Res_N := Res_N - Time_Rep (Off) * Nano;
end;
package body Time_Zones_Operations is
- -- The Unix time bounds in nanoseconds: 1970/1/1 .. 2037/1/1
-
- Unix_Min : constant Time_Rep := Ada_Low +
- Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
-
- Unix_Max : constant Time_Rep := Ada_Low +
- Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day +
- Time_Rep (Leap_Seconds_Count) * Nano;
-
- -- The following constants denote February 28 during non-leap
- -- centennial years, the units are nanoseconds.
-
- T_2100_2_28 : constant Time_Rep := Ada_Low +
- (Time_Rep (49 * 366 + 150 * 365 + 59) * Secs_In_Day +
- Time_Rep (Leap_Seconds_Count)) * Nano;
-
- T_2200_2_28 : constant Time_Rep := Ada_Low +
- (Time_Rep (73 * 366 + 226 * 365 + 59) * Secs_In_Day +
- Time_Rep (Leap_Seconds_Count)) * Nano;
-
- T_2300_2_28 : constant Time_Rep := Ada_Low +
- (Time_Rep (97 * 366 + 302 * 365 + 59) * Secs_In_Day +
- Time_Rep (Leap_Seconds_Count)) * Nano;
-
- -- 56 years (14 leap years + 42 non leap years) in nanoseconds:
-
- Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day;
-
- subtype long is Long_Integer;
- type long_Pointer is access all long;
-
- type time_t is
- range -(2 ** (Standard'Address_Size - Integer'(1))) ..
- +(2 ** (Standard'Address_Size - Integer'(1)) - 1);
- type time_t_Pointer is access all time_t;
-
- procedure localtime_tzoff
- (timer : time_t_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;
- Date_N : Time_Rep;
- Offset : aliased long;
- Secs_T : aliased time_t;
-
begin
- Date_N := Time_Rep (Date);
-
- -- Dates which are 56 years apart fall on the same day, day light
- -- saving and so on. Non-leap centennial years violate this rule by
- -- one day and as a consequence, special adjustment is needed.
-
- Adj_Cent :=
- (if Date_N <= T_2100_2_28 then 0
- elsif Date_N <= T_2200_2_28 then 1
- elsif Date_N <= T_2300_2_28 then 2
- else 3);
-
- if Adj_Cent > 0 then
- Date_N := Date_N - Time_Rep (Adj_Cent) * Nanos_In_Day;
- end if;
-
- -- Shift the date within bounds of Unix time
-
- while Date_N < Unix_Min loop
- Date_N := Date_N + Nanos_In_56_Years;
- end loop;
-
- while Date_N >= Unix_Max loop
- Date_N := Date_N - Nanos_In_56_Years;
- end loop;
-
- -- Perform a shift in origins from Ada to Unix
-
- Date_N := Date_N - Unix_Min;
-
- -- Convert the date into seconds
-
- Secs_T := time_t (Date_N / Nano);
-
- localtime_tzoff
- (Secs_T'Unchecked_Access,
- Offset'Unchecked_Access);
-
- return Offset;
+ return UTC_Time_Offset (Date, True);
end UTC_Time_Offset;
end Time_Zones_Operations;
begin
System.OS_Primitives.Initialize;
+
end Ada.Calendar;
OSDN Git Service
