From cf177287b1d1d835a2e3d169d8c4a3fe3eb6ae5c Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 8 Apr 2008 08:46:17 +0200 Subject: [PATCH] a-calend-vms.ads, [...]: Add with and use clause for System.OS_Primitives. 2008-04-08 Hristian Kirtchev * a-calend-vms.ads, a-calend-vms.adb: Add with and use clause for System.OS_Primitives. Change type of various constants, parameters and local variables from Time to representation type OS_Time. (To_Ada_Time, To_Unix_Time): Correct sign of origin shift. Remove the declaration of constant Mili_F from several routines. New body for internal package Conversions_Operations. (Time_Of): Add default parameters for several formals. * a-caldel.adb: Minor reformatting * a-calend.ads, a-calend.adb: New body for internal package Conversions_Operations. (Time_Of): Add default parameters for several formals. * Makefile.rtl: Add a-ststop Add Ada.Calendar.Conversions to the list of runtime files. Add g-timsta * a-calcon.adb, a-calcon.ads: New files. From-SVN: r134014 --- gcc/ada/Makefile.rtl | 3 + gcc/ada/a-calcon.adb | 150 +++++++++++++++++ gcc/ada/a-calcon.ads | 116 +++++++++++++ gcc/ada/a-caldel.adb | 8 +- gcc/ada/a-calend-vms.adb | 342 +++++++++++++++++++++++++++++++-------- gcc/ada/a-calend-vms.ads | 73 ++++++++- gcc/ada/a-calend.adb | 218 ++++++++++++++++++++++++- gcc/ada/a-calend.ads | 86 +++++++++- 8 files changed, 903 insertions(+), 93 deletions(-) create mode 100644 gcc/ada/a-calcon.adb create mode 100644 gcc/ada/a-calcon.ads diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 9eaa7070d1b..755fa31da85 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -79,6 +79,7 @@ GNATRTL_NONTASKING_OBJS= \ a-calari$(objext) \ a-caldel$(objext) \ a-calend$(objext) \ + a-calcon$(objext) \ a-calfor$(objext) \ a-catizo$(objext) \ a-cdlili$(objext) \ @@ -380,6 +381,7 @@ GNATRTL_NONTASKING_OBJS= \ g-sttsne$(objext) \ g-table$(objext) \ g-tasloc$(objext) \ + g-timsta$(objext) \ g-traceb$(objext) \ g-utf_32$(objext) \ g-u3spch$(objext) \ @@ -558,6 +560,7 @@ GNATRTL_NONTASKING_OBJS= \ s-stopoo$(objext) \ s-stratt$(objext) \ s-strops$(objext) \ + s-ststop$(objext) \ s-soflin$(objext) \ s-memory$(objext) \ s-memcop$(objext) \ diff --git a/gcc/ada/a-calcon.adb b/gcc/ada/a-calcon.adb new file mode 100644 index 00000000000..e946c5ea793 --- /dev/null +++ b/gcc/ada/a-calcon.adb @@ -0,0 +1,150 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . C O N V E R S I O N S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNAT 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Interfaces.C; use Interfaces.C; + +package body Ada.Calendar.Conversions is + + ----------------- + -- To_Ada_Time -- + ----------------- + + function To_Ada_Time (Unix_Time : long) return Time is + Val : constant Long_Integer := Long_Integer (Unix_Time); + begin + return Conversion_Operations.To_Ada_Time (Val); + end To_Ada_Time; + + ----------------- + -- To_Ada_Time -- + ----------------- + + function To_Ada_Time + (tm_year : int; + tm_mon : int; + tm_day : int; + tm_hour : int; + tm_min : int; + tm_sec : int; + tm_isdst : int) return Time + is + Year : constant Integer := Integer (tm_year); + Month : constant Integer := Integer (tm_mon); + Day : constant Integer := Integer (tm_day); + Hour : constant Integer := Integer (tm_hour); + Minute : constant Integer := Integer (tm_min); + Second : constant Integer := Integer (tm_sec); + DST : constant Integer := Integer (tm_isdst); + begin + return + Conversion_Operations.To_Ada_Time + (Year, Month, Day, Hour, Minute, Second, DST); + end To_Ada_Time; + + ----------------- + -- To_Duration -- + ----------------- + + function To_Duration + (tv_sec : long; + tv_nsec : long) return Duration + is + Secs : constant Long_Integer := Long_Integer (tv_sec); + Nano_Secs : constant Long_Integer := Long_Integer (tv_nsec); + begin + return Conversion_Operations.To_Duration (Secs, Nano_Secs); + end To_Duration; + + ------------------------ + -- To_Struct_Timespec -- + ------------------------ + + procedure To_Struct_Timespec + (D : Duration; + tv_sec : out long; + tv_nsec : out long) + is + Secs : Long_Integer; + Nano_Secs : Long_Integer; + + begin + Conversion_Operations.To_Struct_Timespec (D, Secs, Nano_Secs); + + tv_sec := long (Secs); + tv_nsec := long (Nano_Secs); + end To_Struct_Timespec; + + ------------------ + -- To_Struct_Tm -- + ------------------ + + procedure To_Struct_Tm + (T : Time; + tm_year : out int; + tm_mon : out int; + tm_day : out int; + tm_hour : out int; + tm_min : out int; + tm_sec : out int) + is + Year : Integer; + Month : Integer; + Day : Integer; + Hour : Integer; + Minute : Integer; + Second : Integer; + + begin + Conversion_Operations.To_Struct_Tm + (T, Year, Month, Day, Hour, Minute, Second); + + tm_year := int (Year); + tm_mon := int (Month); + tm_day := int (Day); + tm_hour := int (Hour); + tm_min := int (Minute); + tm_sec := int (Second); + end To_Struct_Tm; + + ------------------ + -- To_Unix_Time -- + ------------------ + + function To_Unix_Time (Ada_Time : Time) return long is + Val : constant Long_Integer := + Conversion_Operations.To_Unix_Time (Ada_Time); + begin + return long (Val); + end To_Unix_Time; + +end Ada.Calendar.Conversions; diff --git a/gcc/ada/a-calcon.ads b/gcc/ada/a-calcon.ads new file mode 100644 index 00000000000..d2dd3fbcc10 --- /dev/null +++ b/gcc/ada/a-calcon.ads @@ -0,0 +1,116 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . C O N V E R S I O N S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNAT 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides various routines for conversion between Ada and Unix +-- time models - Time, Duration, struct tm and struct timespec. + +with Interfaces.C; + +package Ada.Calendar.Conversions is + + function To_Ada_Time (Unix_Time : Interfaces.C.long) return Time; + -- Convert a time value represented as number of seconds since the Unix + -- Epoch to a time value relative to an Ada implementation-defined Epoch. + -- The units of the result are 100 nanoseconds on VMS and nanoseconds on + -- all other targets. Raises Time_Error if the result cannot fit into a + -- Time value. + + function To_Ada_Time + (tm_year : Interfaces.C.int; + tm_mon : Interfaces.C.int; + tm_day : Interfaces.C.int; + tm_hour : Interfaces.C.int; + tm_min : Interfaces.C.int; + tm_sec : Interfaces.C.int; + tm_isdst : Interfaces.C.int) return Time; + -- Convert a time value expressed in Unix-like fields of struct tm into + -- a Time value relative to the Ada Epoch. The ranges of the formals are + -- as follows: + + -- tm_year -- years since 1900 + -- tm_mon -- months since January [0 .. 11] + -- tm_day -- day of the month [1 .. 31] + -- tm_hour -- hours since midnight [0 .. 24] + -- tm_min -- minutes after the hour [0 .. 59] + -- tm_sec -- seconds after the minute [0 .. 60] + -- tm_isdst -- Daylight Savings Time flag [-1 .. 1] + + -- The returned value is in UTC and may or may not contain leap seconds + -- depending on whether binder flag "-y" was used. Raises Time_Error if + -- the input values are out of the defined ranges or if tm_sec equals 60 + -- and the instance in time is not a leap second occurence. + + function To_Duration + (tv_sec : Interfaces.C.long; + tv_nsec : Interfaces.C.long) return Duration; + -- Convert an elapsed time value expressed in Unix-like fields of struct + -- timespec into a Duration value. The expected ranges are: + + -- tv_sec - seconds + -- tv_nsec - nanoseconds + + procedure To_Struct_Timespec + (D : Duration; + tv_sec : out Interfaces.C.long; + tv_nsec : out Interfaces.C.long); + -- Convert a Duration value into the constituents of struct timespec. + -- Formal tv_sec denotes seconds and tv_nsecs denotes nanoseconds. + + procedure To_Struct_Tm + (T : Time; + tm_year : out Interfaces.C.int; + tm_mon : out Interfaces.C.int; + tm_day : out Interfaces.C.int; + tm_hour : out Interfaces.C.int; + tm_min : out Interfaces.C.int; + tm_sec : out Interfaces.C.int); + -- Convert a Time value set in the Ada Epoch into the constituents of + -- struct tm. The ranges of the out formals are as follows: + + -- tm_year -- years since 1900 + -- tm_mon -- months since January [0 .. 11] + -- tm_day -- day of the month [1 .. 31] + -- tm_hour -- hours since midnight [0 .. 24] + -- tm_min -- minutes after the hour [0 .. 59] + -- tm_sec -- seconds after the minute [0 .. 60] + -- tm_isdst -- Daylight Savings Time flag [-1 .. 1] + + -- The input date is considered to be in UTC + + function To_Unix_Time (Ada_Time : Time) return Interfaces.C.long; + -- Convert a time value represented as number of time units since the Ada + -- implementation-defined Epoch to a value relative to the Unix Epoch. The + -- units of the result are seconds. Raises Time_Error if the result cannot + -- fit into a Time value. + +end Ada.Calendar.Conversions; diff --git a/gcc/ada/a-caldel.adb b/gcc/ada/a-caldel.adb index 3410b6135fe..17b39977714 100644 --- a/gcc/ada/a-caldel.adb +++ b/gcc/ada/a-caldel.adb @@ -116,15 +116,13 @@ package body Ada.Calendar.Delays is -- target independent operation in Ada.Calendar is used to perform -- this conversion. - return Delays_Operations.To_Duration (T); + return Delay_Operations.To_Duration (T); end To_Duration; begin -- Set up the Timed_Delay soft link to the non tasking version if it has - -- not been already set. - - -- If tasking is present, Timed_Delay has already set this soft link, or - -- this will be overridden during the elaboration of + -- not been already set. If tasking is present, Timed_Delay has already set + -- this soft link, or this will be overridden during the elaboration of -- System.Tasking.Initialization if SSL.Timed_Delay = null then diff --git a/gcc/ada/a-calend-vms.adb b/gcc/ada/a-calend-vms.adb index 89cda37c8f3..86e77cb66a6 100644 --- a/gcc/ada/a-calend-vms.adb +++ b/gcc/ada/a-calend-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -33,10 +33,11 @@ -- This is the Alpha/VMS version -with System.Aux_DEC; use System.Aux_DEC; - with Ada.Unchecked_Conversion; +with System.Aux_DEC; use System.Aux_DEC; +with System.OS_Primitives; use System.OS_Primitives; + package body Ada.Calendar is -------------------------- @@ -77,15 +78,15 @@ package body Ada.Calendar is -- Local Subprograms -- ----------------------- - procedure Check_Within_Time_Bounds (T : Time); + procedure Check_Within_Time_Bounds (T : OS_Time); -- Ensure that a time representation value falls withing the bounds of Ada -- time. Leap seconds support is taken into account. procedure Cumulative_Leap_Seconds - (Start_Date : Time; - End_Date : Time; + (Start_Date : OS_Time; + End_Date : OS_Time; Elapsed_Leaps : out Natural; - Next_Leap_Sec : out Time); + Next_Leap_Sec : out OS_Time); -- Elapsed_Leaps is the sum of the leap seconds that have occurred on or -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec -- represents the next leap second occurrence on or after End_Date. If @@ -135,26 +136,26 @@ package body Ada.Calendar is -- The range of Ada time expressed as milis since the VMS Epoch - Ada_Low : constant Time := (10 * 366 + 32 * 365 + 45) * Milis_In_Day; - Ada_High : constant Time := (131 * 366 + 410 * 365 + 45) * Milis_In_Day; + Ada_Low : constant OS_Time := (10 * 366 + 32 * 365 + 45) * Milis_In_Day; + Ada_High : constant OS_Time := (131 * 366 + 410 * 365 + 45) * Milis_In_Day; -- Even though the upper bound of time is 2399-12-31 23:59:59.9999999 -- UTC, it must be increased to include all leap seconds. - Ada_High_And_Leaps : constant Time := - Ada_High + Time (Leap_Seconds_Count) * Mili; + Ada_High_And_Leaps : constant OS_Time := + Ada_High + OS_Time (Leap_Seconds_Count) * Mili; -- Two constants used in the calculations of elapsed leap seconds. -- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time -- is earlier than Ada_Low in time zone +28. - End_Of_Time : constant Time := Ada_High + Time (3) * Milis_In_Day; - Start_Of_Time : constant Time := Ada_Low - Time (3) * Milis_In_Day; + End_Of_Time : constant OS_Time := Ada_High + OS_Time (3) * Milis_In_Day; + Start_Of_Time : constant OS_Time := Ada_Low - OS_Time (3) * Milis_In_Day; -- The following table contains the hard time values of all existing leap -- seconds. The values are produced by the utility program xleaps.adb. - Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of Time := + Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of OS_Time := (35855136000000000, 36014112010000000, 36329472020000000, @@ -219,13 +220,15 @@ package body Ada.Calendar is -- The bound of type Duration expressed as time - Dur_High : constant Time := To_Relative_Time (Duration'Last); - Dur_Low : constant Time := To_Relative_Time (Duration'First); + Dur_High : constant OS_Time := + OS_Time (To_Relative_Time (Duration'Last)); + Dur_Low : constant OS_Time := + OS_Time (To_Relative_Time (Duration'First)); - Res_M : Time; + Res_M : OS_Time; begin - Res_M := Left - Right; + Res_M := OS_Time (Left) - OS_Time (Right); -- Due to the extended range of Ada time, "-" is capable of producing -- results which may exceed the range of Duration. In order to prevent @@ -240,7 +243,7 @@ package body Ada.Calendar is -- Normal case, result fits else - return To_Duration (Res_M); + return To_Duration (Time (Res_M)); end if; exception @@ -254,7 +257,7 @@ package body Ada.Calendar is function "<" (Left, Right : Time) return Boolean is begin - return Long_Integer (Left) < Long_Integer (Right); + return OS_Time (Left) < OS_Time (Right); end "<"; ---------- @@ -263,7 +266,7 @@ package body Ada.Calendar is function "<=" (Left, Right : Time) return Boolean is begin - return Long_Integer (Left) <= Long_Integer (Right); + return OS_Time (Left) <= OS_Time (Right); end "<="; --------- @@ -272,7 +275,7 @@ package body Ada.Calendar is function ">" (Left, Right : Time) return Boolean is begin - return Long_Integer (Left) > Long_Integer (Right); + return OS_Time (Left) > OS_Time (Right); end ">"; ---------- @@ -281,14 +284,14 @@ package body Ada.Calendar is function ">=" (Left, Right : Time) return Boolean is begin - return Long_Integer (Left) >= Long_Integer (Right); + return OS_Time (Left) >= OS_Time (Right); end ">="; ------------------------------ -- Check_Within_Time_Bounds -- ------------------------------ - procedure Check_Within_Time_Bounds (T : Time) is + procedure Check_Within_Time_Bounds (T : OS_Time) is begin if Leap_Support then if T < Ada_Low or else T > Ada_High_And_Leaps then @@ -307,8 +310,8 @@ package body Ada.Calendar is function Clock return Time is Elapsed_Leaps : Natural; - Next_Leap_M : Time; - Res_M : constant Time := Time (OSP.OS_Clock); + Next_Leap_M : OS_Time; + Res_M : constant OS_Time := OS_Clock; begin -- Note that on other targets a soft-link is used to get a different @@ -335,7 +338,7 @@ package body Ada.Calendar is Elapsed_Leaps := 0; end if; - return Res_M + Time (Elapsed_Leaps) * Mili; + return Time (Res_M + OS_Time (Elapsed_Leaps) * Mili); end Clock; ----------------------------- @@ -343,15 +346,15 @@ package body Ada.Calendar is ----------------------------- procedure Cumulative_Leap_Seconds - (Start_Date : Time; - End_Date : Time; + (Start_Date : OS_Time; + End_Date : OS_Time; Elapsed_Leaps : out Natural; - Next_Leap_Sec : out Time) + Next_Leap_Sec : out OS_Time) is End_Index : Positive; - End_T : Time := End_Date; + End_T : OS_Time := End_Date; Start_Index : Positive; - Start_T : Time := Start_Date; + Start_T : OS_Time := Start_Date; begin pragma Assert (Leap_Support and then End_Date >= Start_Date); @@ -641,8 +644,9 @@ package body Ada.Calendar is function Add (Date : Time; Days : Long_Integer) return Time is pragma Unsuppress (Overflow_Check); + Date_M : constant OS_Time := OS_Time (Date); begin - return Date + Time (Days) * Milis_In_Day; + return Time (Date_M + OS_Time (Days) * Milis_In_Day); exception when Constraint_Error => raise Time_Error; @@ -659,15 +663,13 @@ package body Ada.Calendar is Seconds : out Duration; Leap_Seconds : out Integer) is - Mili_F : constant Duration := 10_000_000.0; - - Diff_M : Time; - Diff_S : Time; - Earlier : Time; + Diff_M : OS_Time; + Diff_S : OS_Time; + Earlier : OS_Time; Elapsed_Leaps : Natural; - Later : Time; + Later : OS_Time; Negate : Boolean := False; - Next_Leap : Time; + Next_Leap : OS_Time; Sub_Seconds : Duration; begin @@ -675,11 +677,11 @@ package body Ada.Calendar is -- being raised by the arithmetic operators in Ada.Calendar. if Left >= Right then - Later := Left; - Earlier := Right; + Later := OS_Time (Left); + Earlier := OS_Time (Right); else - Later := Right; - Earlier := Left; + Later := OS_Time (Right); + Earlier := OS_Time (Left); Negate := True; end if; @@ -699,7 +701,7 @@ package body Ada.Calendar is Elapsed_Leaps := 0; end if; - Diff_M := Later - Earlier - Time (Elapsed_Leaps) * Mili; + Diff_M := Later - Earlier - OS_Time (Elapsed_Leaps) * Mili; -- Sub second processing @@ -730,14 +732,218 @@ package body Ada.Calendar is function Subtract (Date : Time; Days : Long_Integer) return Time is pragma Unsuppress (Overflow_Check); + Date_M : constant OS_Time := OS_Time (Date); begin - return Date - Time (Days) * Milis_In_Day; + return Time (Date_M - OS_Time (Days) * Milis_In_Day); exception when Constraint_Error => raise Time_Error; end Subtract; end Arithmetic_Operations; + --------------------------- + -- Conversion_Operations -- + --------------------------- + + package body Conversion_Operations is + + Epoch_Offset : constant OS_Time := 35067168000000000; + -- The difference between 1970-1-1 UTC and 1858-11-17 UTC expressed in + -- 100 nanoseconds. + + ----------------- + -- To_Ada_Time -- + ----------------- + + function To_Ada_Time (Unix_Time : Long_Integer) return Time is + pragma Unsuppress (Overflow_Check); + Unix_Rep : constant OS_Time := OS_Time (Unix_Time) * Mili; + begin + return Time (Unix_Rep + Epoch_Offset); + exception + when Constraint_Error => + raise Time_Error; + end To_Ada_Time; + + ----------------- + -- To_Ada_Time -- + ----------------- + + function To_Ada_Time + (tm_year : Integer; + tm_mon : Integer; + tm_day : Integer; + tm_hour : Integer; + tm_min : Integer; + tm_sec : Integer; + tm_isdst : Integer) return Time + is + pragma Unsuppress (Overflow_Check); + + Year_Shift : constant Integer := 1900; + Month_Shift : constant Integer := 1; + + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Second : Integer; + Leap : Boolean; + Result : OS_Time; + + begin + -- Input processing + + Year := Year_Number (Year_Shift + tm_year); + Month := Month_Number (Month_Shift + tm_mon); + Day := Day_Number (tm_day); + + -- Step 1: Validity checks of input values + + if not Year'Valid + or else not Month'Valid + or else not Day'Valid + or else tm_hour not in 0 .. 24 + or else tm_min not in 0 .. 59 + or else tm_sec not in 0 .. 60 + or else tm_isdst not in -1 .. 1 + then + raise Time_Error; + end if; + + -- Step 2: Potential leap second + + if tm_sec = 60 then + Leap := True; + Second := 59; + else + Leap := False; + Second := tm_sec; + end if; + + -- Step 3: Calculate the time value + + Result := + OS_Time + (Formatting_Operations.Time_Of + (Year => Year, + Month => Month, + Day => Day, + Day_Secs => 0.0, -- Time is given in h:m:s + Hour => tm_hour, + Minute => tm_min, + Second => Second, + Sub_Sec => 0.0, -- No precise sub second given + Leap_Sec => Leap, + Use_Day_Secs => False, -- Time is given in h:m:s + Is_Ada_05 => True, -- Force usage of explicit time zone + Time_Zone => 0)); -- Place the value in UTC + -- Step 4: Daylight Savings Time + + if tm_isdst = 1 then + Result := Result + OS_Time (3_600) * Mili; + end if; + + return Time (Result); + exception + when Constraint_Error => + raise Time_Error; + end To_Ada_Time; + + ----------------- + -- To_Duration -- + ----------------- + + function To_Duration + (tv_sec : Long_Integer; + tv_nsec : Long_Integer) return Duration + is + pragma Unsuppress (Overflow_Check); + begin + return Duration (tv_sec) + Duration (tv_nsec) / Mili_F; + end To_Duration; + + ------------------------ + -- To_Struct_Timespec -- + ------------------------ + + procedure To_Struct_Timespec + (D : Duration; + tv_sec : out Long_Integer; + tv_nsec : out Long_Integer) + is + pragma Unsuppress (Overflow_Check); + Secs : Duration; + Nano_Secs : Duration; + + begin + -- Seconds extraction, avoid potential rounding errors + + Secs := D - 0.5; + tv_sec := Long_Integer (Secs); + + -- 100 Nanoseconds extraction + + Nano_Secs := D - Duration (tv_sec); + tv_nsec := Long_Integer (Nano_Secs * Mili); + end To_Struct_Timespec; + + ------------------ + -- To_Struct_Tm -- + ------------------ + + procedure To_Struct_Tm + (T : Time; + tm_year : out Integer; + tm_mon : out Integer; + tm_day : out Integer; + tm_hour : out Integer; + tm_min : out Integer; + tm_sec : out Integer) + is + pragma Unsuppress (Overflow_Check); + Year : Year_Number; + Month : Month_Number; + Second : Integer; + Day_Secs : Day_Duration; + Sub_Sec : Duration; + Leap_Sec : Boolean; + + begin + -- Step 1: Split the input time + + Formatting_Operations.Split + (T, Year, Month, tm_day, Day_Secs, + tm_hour, tm_min, Second, Sub_Sec, Leap_Sec, True, 0); + + -- Step 2: Correct the year and month + + tm_year := Year - 1900; + tm_mon := Month - 1; + + -- Step 3: Handle leap second occurences + + if Leap_Sec then + tm_sec := 60; + else + tm_sec := Second; + end if; + end To_Struct_Tm; + + ------------------ + -- To_Unix_Time -- + ------------------ + + function To_Unix_Time (Ada_Time : Time) return Long_Integer is + pragma Unsuppress (Overflow_Check); + Ada_OS_Time : constant OS_Time := OS_Time (Ada_Time); + begin + return Long_Integer ((Ada_OS_Time - Epoch_Offset) / Mili); + exception + when Constraint_Error => + raise Time_Error; + end To_Unix_Time; + end Conversion_Operations; + --------------------------- -- Formatting_Operations -- --------------------------- @@ -812,20 +1018,19 @@ package body Ada.Calendar is Ada_Min_Year : constant := 1901; Ada_Max_Year : constant := 2399; - Mili_F : constant Duration := 10_000_000.0; - Date_M : Time; + Date_M : OS_Time; Elapsed_Leaps : Natural; - Next_Leap_M : Time; + Next_Leap_M : OS_Time; begin - Date_M := Date; + Date_M := OS_Time (Date); -- Step 1: Leap seconds processing if Leap_Support then Cumulative_Leap_Seconds - (Start_Of_Time, Date, Elapsed_Leaps, Next_Leap_M); + (Start_Of_Time, Date_M, Elapsed_Leaps, Next_Leap_M); Leap_Sec := Date_M >= Next_Leap_M; @@ -840,12 +1045,12 @@ package body Ada.Calendar is Leap_Sec := False; end if; - Date_M := Date_M - Time (Elapsed_Leaps) * Mili; + Date_M := Date_M - OS_Time (Elapsed_Leaps) * Mili; -- Step 2: Time zone processing if Time_Zone /= 0 then - Date_M := Date_M + Time (Time_Zone) * 60 * Mili; + Date_M := Date_M + OS_Time (Time_Zone) * 60 * Mili; end if; -- After the leap seconds and time zone have been accounted for, @@ -867,7 +1072,7 @@ package body Ada.Calendar is -- Step 4: VMS system call - Numtim (Status, Timbuf, Date_M); + Numtim (Status, Timbuf, Time (Date_M)); if Status mod 2 /= 1 or else Timbuf (1) not in Ada_Min_Year .. Ada_Max_Year @@ -903,10 +1108,10 @@ package body Ada.Calendar is Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean; - Use_Day_Secs : Boolean; - Is_Ada_05 : Boolean; - Time_Zone : Long_Integer) return Time + Leap_Sec : Boolean := False; + Use_Day_Secs : Boolean := False; + Is_Ada_05 : Boolean := False; + Time_Zone : Long_Integer := 0) return Time is procedure Cvt_Vectim (Status : out Unsigned_Longword; @@ -923,8 +1128,6 @@ package body Ada.Calendar is Status : Unsigned_Longword; Timbuf : Unsigned_Word_Array (1 .. 7); - Mili_F : constant := 10_000_000.0; - Y : Year_Number := Year; Mo : Month_Number := Month; D : Day_Number := Day; @@ -935,9 +1138,10 @@ package body Ada.Calendar is Elapsed_Leaps : Natural; Int_Day_Secs : Integer; - Next_Leap_M : Time; - Res_M : Time; - Rounded_Res_M : Time; + Next_Leap_M : OS_Time; + Res : Time; + Res_M : OS_Time; + Rounded_Res_M : OS_Time; begin -- No validity checks are performed on the input values since it is @@ -1015,7 +1219,7 @@ package body Ada.Calendar is Timbuf (6) := Unsigned_Word (Se); Timbuf (7) := 0; - Cvt_Vectim (Status, Timbuf, Res_M); + Cvt_Vectim (Status, Timbuf, Res); if Status mod 2 /= 1 then raise Time_Error; @@ -1023,7 +1227,7 @@ package body Ada.Calendar is -- Step 3: Sub second adjustment - Res_M := Res_M + Time (Su * Mili_F); + Res_M := OS_Time (Res) + OS_Time (Su * Mili_F); -- Step 4: Bounds check @@ -1032,7 +1236,7 @@ package body Ada.Calendar is -- Step 5: Time zone processing if Time_Zone /= 0 then - Res_M := Res_M - Time (Time_Zone) * 60 * Mili; + Res_M := Res_M - OS_Time (Time_Zone) * 60 * Mili; end if; -- Step 6: Leap seconds processing @@ -1041,7 +1245,7 @@ package body Ada.Calendar is Cumulative_Leap_Seconds (Start_Of_Time, Res_M, Elapsed_Leaps, Next_Leap_M); - Res_M := Res_M + Time (Elapsed_Leaps) * Mili; + Res_M := Res_M + OS_Time (Elapsed_Leaps) * Mili; -- An Ada 2005 caller requesting an explicit leap second or an -- Ada 95 caller accounting for an invisible leap second. @@ -1049,7 +1253,7 @@ package body Ada.Calendar is if Leap_Sec or else Res_M >= Next_Leap_M then - Res_M := Res_M + Time (1) * Mili; + Res_M := Res_M + OS_Time (1) * Mili; end if; -- Leap second validity check @@ -1064,7 +1268,7 @@ package body Ada.Calendar is end if; end if; - return Res_M; + return Time (Res_M); end Time_Of; end Formatting_Operations; diff --git a/gcc/ada/a-calend-vms.ads b/gcc/ada/a-calend-vms.ads index 108bd868179..c11093df238 100644 --- a/gcc/ada/a-calend-vms.ads +++ b/gcc/ada/a-calend-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -107,6 +107,7 @@ private -- readability, this unit will be called "mili". Mili : constant := 10_000_000; + Mili_F : constant := 10_000_000.0; Milis_In_Day : constant := 864_000_000_000; Secs_In_Day : constant := 86_400; @@ -139,7 +140,12 @@ private -- NOTE: Delays does not need a target independent interface because -- VMS already has a target specific file for that package. + --------------------------- + -- Arithmetic_Operations -- + --------------------------- + package Arithmetic_Operations is + function Add (Date : Time; Days : Long_Integer) return Time; -- Add a certain number of days to a time value @@ -156,9 +162,59 @@ private function Subtract (Date : Time; Days : Long_Integer) return Time; -- Subtract a certain number of days from a time value + end Arithmetic_Operations; + --------------------------- + -- Conversion_Operations -- + --------------------------- + + package Conversion_Operations is + function To_Ada_Time (Unix_Time : Long_Integer) return Time; + -- Unix to Ada Epoch conversion + + function To_Ada_Time + (tm_year : Integer; + tm_mon : Integer; + tm_day : Integer; + tm_hour : Integer; + tm_min : Integer; + tm_sec : Integer; + tm_isdst : Integer) return Time; + -- Struct tm to Ada Epoch conversion + + function To_Duration + (tv_sec : Long_Integer; + tv_nsec : Long_Integer) return Duration; + -- Struct timespec to Duration conversion + + procedure To_Struct_Timespec + (D : Duration; + tv_sec : out Long_Integer; + tv_nsec : out Long_Integer); + -- Duration to struct timespec conversion + + procedure To_Struct_Tm + (T : Time; + tm_year : out Integer; + tm_mon : out Integer; + tm_day : out Integer; + tm_hour : out Integer; + tm_min : out Integer; + tm_sec : out Integer); + -- Time to struct tm conversion + + function To_Unix_Time (Ada_Time : Time) return Long_Integer; + -- Ada to Unix Epoch conversion + + end Conversion_Operations; + + --------------------------- + -- Formatting_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). @@ -189,21 +245,28 @@ private Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean; - Use_Day_Secs : Boolean; - Is_Ada_05 : Boolean; - Time_Zone : Long_Integer) return Time; + Leap_Sec : Boolean := False; + Use_Day_Secs : Boolean := False; + Is_Ada_05 : Boolean := False; + Time_Zone : Long_Integer := 0) 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 Is_Ada_05 to use the local time zone (the value in formal -- Time_Zone is ignored) when building a time value and to verify the -- validity of a requested leap second. + end Formatting_Operations; + --------------------------- + -- Time_Zones_Operations -- + --------------------------- + package Time_Zones_Operations is + function UTC_Time_Offset (Date : Time) return Long_Integer; -- Return the offset in seconds from UTC + end Time_Zones_Operations; end Ada.Calendar; diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index 1fe977d68a4..2e7c61a9d7f 100644 --- a/gcc/ada/a-calend.adb +++ b/gcc/ada/a-calend.adb @@ -758,13 +758,216 @@ package body Ada.Calendar is when Constraint_Error => raise Time_Error; end Subtract; + end Arithmetic_Operations; + --------------------------- + -- Conversion_Operations -- + --------------------------- + + package body Conversion_Operations is + + 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. + + ----------------- + -- To_Ada_Time -- + ----------------- + + function To_Ada_Time (Unix_Time : Long_Integer) return Time is + pragma Unsuppress (Overflow_Check); + Unix_Rep : constant Time_Rep := Time_Rep (Unix_Time) * Nano; + begin + return Time (Unix_Rep - Epoch_Offset); + exception + when Constraint_Error => + raise Time_Error; + end To_Ada_Time; + + ----------------- + -- To_Ada_Time -- + ----------------- + + function To_Ada_Time + (tm_year : Integer; + tm_mon : Integer; + tm_day : Integer; + tm_hour : Integer; + tm_min : Integer; + tm_sec : Integer; + tm_isdst : Integer) return Time + is + pragma Unsuppress (Overflow_Check); + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Second : Integer; + Leap : Boolean; + Result : Time_Rep; + + begin + -- Input processing + + Year := Year_Number (1900 + tm_year); + Month := Month_Number (1 + tm_mon); + Day := Day_Number (tm_day); + + -- Step 1: Validity checks of input values + + if not Year'Valid + or else not Month'Valid + or else not Day'Valid + or else tm_hour not in 0 .. 24 + or else tm_min not in 0 .. 59 + or else tm_sec not in 0 .. 60 + or else tm_isdst not in -1 .. 1 + then + raise Time_Error; + end if; + + -- Step 2: Potential leap second + + if tm_sec = 60 then + Leap := True; + Second := 59; + else + Leap := False; + Second := tm_sec; + end if; + + -- Step 3: Calculate the time value + + Result := + Time_Rep + (Formatting_Operations.Time_Of + (Year => Year, + Month => Month, + Day => Day, + Day_Secs => 0.0, -- Time is given in h:m:s + Hour => tm_hour, + Minute => tm_min, + Second => Second, + Sub_Sec => 0.0, -- No precise sub second given + Leap_Sec => Leap, + Use_Day_Secs => False, -- Time is given in h:m:s + Is_Ada_05 => True, -- Force usage of explicit time zone + Time_Zone => 0)); -- Place the value in UTC + + -- Step 4: Daylight Savings Time + + if tm_isdst = 1 then + Result := Result + Time_Rep (3_600) * Nano; + end if; + + return Time (Result); + + exception + when Constraint_Error => + raise Time_Error; + end To_Ada_Time; + + ----------------- + -- To_Duration -- + ----------------- + + function To_Duration + (tv_sec : Long_Integer; + tv_nsec : Long_Integer) return Duration + is + pragma Unsuppress (Overflow_Check); + begin + return Duration (tv_sec) + Duration (tv_nsec) / Nano_F; + end To_Duration; + + ------------------------ + -- To_Struct_Timespec -- + ------------------------ + + procedure To_Struct_Timespec + (D : Duration; + tv_sec : out Long_Integer; + tv_nsec : out Long_Integer) + is + pragma Unsuppress (Overflow_Check); + Secs : Duration; + Nano_Secs : Duration; + + begin + -- Seconds extraction, avoid potential rounding errors + + Secs := D - 0.5; + tv_sec := Long_Integer (Secs); + + -- Nanoseconds extraction + + Nano_Secs := D - Duration (tv_sec); + tv_nsec := Long_Integer (Nano_Secs * Nano); + end To_Struct_Timespec; + + ------------------ + -- To_Struct_Tm -- + ------------------ + + procedure To_Struct_Tm + (T : Time; + tm_year : out Integer; + tm_mon : out Integer; + tm_day : out Integer; + tm_hour : out Integer; + tm_min : out Integer; + tm_sec : out Integer) + is + pragma Unsuppress (Overflow_Check); + Year : Year_Number; + Month : Month_Number; + Second : Integer; + Day_Secs : Day_Duration; + Sub_Sec : Duration; + Leap_Sec : Boolean; + + begin + -- Step 1: Split the input time + + Formatting_Operations.Split + (T, Year, Month, tm_day, Day_Secs, + tm_hour, tm_min, Second, Sub_Sec, Leap_Sec, True, 0); + + -- Step 2: Correct the year and month + + tm_year := Year - 1900; + tm_mon := Month - 1; + + -- Step 3: Handle leap second occurences + + if Leap_Sec then + tm_sec := 60; + else + tm_sec := Second; + end if; + end To_Struct_Tm; + + ------------------ + -- To_Unix_Time -- + ------------------ + + function To_Unix_Time (Ada_Time : Time) return Long_Integer is + pragma Unsuppress (Overflow_Check); + Ada_Rep : constant Time_Rep := Time_Rep (Ada_Time); + begin + return Long_Integer ((Ada_Rep + Epoch_Offset) / Nano); + exception + when Constraint_Error => + raise Time_Error; + end To_Unix_Time; + end Conversion_Operations; + ---------------------- -- Delay_Operations -- ---------------------- - package body Delays_Operations is + package body Delay_Operations is ----------------- -- To_Duration -- @@ -804,7 +1007,8 @@ package body Ada.Calendar is return Time (Res_N) - Time (Unix_Min); end To_Duration; - end Delays_Operations; + + end Delay_Operations; --------------------------- -- Formatting_Operations -- @@ -1071,10 +1275,10 @@ package body Ada.Calendar is Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean; - Use_Day_Secs : Boolean; - Is_Ada_05 : Boolean; - Time_Zone : Long_Integer) return Time + Leap_Sec : Boolean := False; + Use_Day_Secs : Boolean := False; + Is_Ada_05 : Boolean := False; + Time_Zone : Long_Integer := 0) return Time is Count : Integer; Elapsed_Leaps : Natural; @@ -1217,6 +1421,7 @@ package body Ada.Calendar is return Time (Res_N); end Time_Of; + end Formatting_Operations; --------------------------- @@ -1352,6 +1557,7 @@ package body Ada.Calendar is return Offset; end UTC_Time_Offset; + end Time_Zones_Operations; -- Start of elaboration code for Ada.Calendar diff --git a/gcc/ada/a-calend.ads b/gcc/ada/a-calend.ads index 2bacb9ba823..77b466a87c4 100644 --- a/gcc/ada/a-calend.ads +++ b/gcc/ada/a-calend.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -212,9 +212,15 @@ private -- 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. + -- children of Calendar - Arithmetic, Conversions, Delays, Formatting and + -- Time_Zones. + + --------------------------- + -- Arithmetic_Operations -- + --------------------------- package Arithmetic_Operations is + function Add (Date : Time; Days : Long_Integer) return Time; -- Add a certain number of days to a time value @@ -231,15 +237,72 @@ private function Subtract (Date : Time; Days : Long_Integer) return Time; -- Subtract a certain number of days from a time value + end Arithmetic_Operations; - package Delays_Operations is + --------------------------- + -- Conversion_Operations -- + --------------------------- + + package Conversion_Operations is + + function To_Ada_Time (Unix_Time : Long_Integer) return Time; + -- Unix to Ada Epoch conversion + + function To_Ada_Time + (tm_year : Integer; + tm_mon : Integer; + tm_day : Integer; + tm_hour : Integer; + tm_min : Integer; + tm_sec : Integer; + tm_isdst : Integer) return Time; + -- Struct tm to Ada Epoch conversion + + function To_Duration + (tv_sec : Long_Integer; + tv_nsec : Long_Integer) return Duration; + -- Struct timespec to Duration conversion + + procedure To_Struct_Timespec + (D : Duration; + tv_sec : out Long_Integer; + tv_nsec : out Long_Integer); + -- Duration to struct timespec conversion + + procedure To_Struct_Tm + (T : Time; + tm_year : out Integer; + tm_mon : out Integer; + tm_day : out Integer; + tm_hour : out Integer; + tm_min : out Integer; + tm_sec : out Integer); + -- Time to struct tm conversion + + function To_Unix_Time (Ada_Time : Time) return Long_Integer; + -- Ada to Unix Epoch conversion + + end Conversion_Operations; + + ---------------------- + -- Delay_Operations -- + ---------------------- + + package Delay_Operations is + function To_Duration (Date : 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; + + end Delay_Operations; + + --------------------------- + -- Formatting_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). @@ -270,21 +333,28 @@ private Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean; - Use_Day_Secs : Boolean; - Is_Ada_05 : Boolean; - Time_Zone : Long_Integer) return Time; + Leap_Sec : Boolean := False; + Use_Day_Secs : Boolean := False; + Is_Ada_05 : Boolean := False; + Time_Zone : Long_Integer := 0) 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 Is_Ada_05 to use the local time zone (the value in formal -- Time_Zone is ignored) when building a time value and to verify the -- validity of a requested leap second. + end Formatting_Operations; + --------------------------- + -- Time_Zones_Operations -- + --------------------------- + package Time_Zones_Operations is + function UTC_Time_Offset (Date : Time) return Long_Integer; -- Return the offset in seconds from UTC + end Time_Zones_Operations; end Ada.Calendar; -- 2.30.2