diff options
| author | Hristian Kirtchev <kirtchev@adacore.com> | 2006-10-31 18:44:55 +0100 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2006-10-31 18:44:55 +0100 |
| commit | 6e451134f0ac90864186b1a1595a86ee393cf41a (patch) | |
| tree | 203369273dd14a7ee74aea51ee6f81faf1d82050 /gcc | |
| parent | 014c9caac5151925c7ec3c7243bfc84daf660a31 (diff) | |
| download | gcc-6e451134f0ac90864186b1a1595a86ee393cf41a.zip gcc-6e451134f0ac90864186b1a1595a86ee393cf41a.tar.gz gcc-6e451134f0ac90864186b1a1595a86ee393cf41a.tar.bz2 | |
a-calend-vms.adb (Leap_Sec_Ops): Temp body for package in private part of Ada.Calendar...
2006-10-31 Hristian Kirtchev <kirtchev@adacore.com>
Jose Ruiz <ruiz@adacore.com>
* a-calend-vms.adb (Leap_Sec_Ops): Temp body for package in private
part of Ada.Calendar: all subprogram raise Unimplemented.
(Split_W_Offset): Temp function body, raising Unimplemented
* a-calend.ads, a-calend-vms.ads:
Add imported variable Invalid_TZ_Offset used to designate targets unable
to support time zones.
(Unimplemented): Temporary function raised by the body of new
subprograms below.
(Leap_Sec_Ops): New package in the private part of Ada.Calendar. This
unit provides handling of leap seconds and is used by the new Ada 2005
packages Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
(Split_W_Offset): Identical spec to that of Ada.Calendar.Split. This
version returns an extra value which is the offset to UTC.
* a-calend.adb (Split_W_Offset): Add call to localtime_tzoff.
(Leap_Sec_Ops): New body for package in private part of Ada.Calendar.
(Split_W_Offset): New function body.
(Time_Of): When a date is close to UNIX epoch, compute the time for
that date plus one day (that amount is later substracted after
executing mktime) so there are no problems with time zone adjustments.
* a-calend-mingw.adb: Remove Windows specific version no longer needed.
* a-calari.ads, a-calari.adb, a-calfor.ads, a-calfor.adb,
a-catizo.ads, a-catizo.adb: New files.
* impunit.adb: Add new Ada 2005 entries
* sysdep.c: Add external variable __gnat_invalid_tz_offset.
Rename all occurences of "__gnat_localtime_r" to
"__gnat_localtime_tzoff".
(__gnat_localtime_tzoff for Windows): Add logic to retrieve the time
zone data and calculate the GMT offset.
(__gnat_localtime_tzoff for Darwin, Free BSD, Linux, Lynx and Tru64):
Use the field "tm_gmtoff" to extract the GMT offset.
(__gnat_localtime_tzoff for AIX, HPUX, SGI Irix and Sun Solaris): Use
the external variable "timezone" to calculate the GMT offset.
From-SVN: r118234
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/a-calari.adb | 142 | ||||
| -rw-r--r-- | gcc/ada/a-calari.ads | 60 | ||||
| -rw-r--r-- | gcc/ada/a-calend-mingw.adb | 397 | ||||
| -rw-r--r-- | gcc/ada/a-calend-vms.adb | 61 | ||||
| -rw-r--r-- | gcc/ada/a-calend-vms.ads | 66 | ||||
| -rw-r--r-- | gcc/ada/a-calend.adb | 254 | ||||
| -rw-r--r-- | gcc/ada/a-calend.ads | 64 | ||||
| -rw-r--r-- | gcc/ada/a-calfor.adb | 1135 | ||||
| -rw-r--r-- | gcc/ada/a-calfor.ads | 163 | ||||
| -rw-r--r-- | gcc/ada/a-catizo.adb | 67 | ||||
| -rw-r--r-- | gcc/ada/a-catizo.ads | 48 | ||||
| -rw-r--r-- | gcc/ada/impunit.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sysdep.c | 83 |
13 files changed, 2121 insertions, 435 deletions
diff --git a/gcc/ada/a-calari.adb b/gcc/ada/a-calari.adb new file mode 100644 index 0000000..de02a90 --- /dev/null +++ b/gcc/ada/a-calari.adb @@ -0,0 +1,142 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . A R I T H M E T I C -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2006, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, 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 Unchecked_Conversion; + +package body Ada.Calendar.Arithmetic is + + use Leap_Sec_Ops; + + Day_Duration : constant Duration := 86_400.0; + + --------- + -- "+" -- + --------- + + function "+" (Left : Time; Right : Day_Count) return Time is + begin + return Left + Integer (Right) * Day_Duration; + end "+"; + + function "+" (Left : Day_Count; Right : Time) return Time is + begin + return Integer (Left) * Day_Duration + Right; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (Left : Time; Right : Day_Count) return Time is + begin + return Left - Integer (Right) * Day_Duration; + end "-"; + + function "-" (Left, Right : Time) return Day_Count is + Days : Day_Count; + Seconds : Duration; + Leap_Seconds : Leap_Seconds_Count; + + begin + Difference (Left, Right, Days, Seconds, Leap_Seconds); + return Days; + end "-"; + + ---------------- + -- Difference -- + ---------------- + + procedure Difference + (Left, Right : Time; + Days : out Day_Count; + Seconds : out Duration; + Leap_Seconds : out Leap_Seconds_Count) + is + Diff : Duration; + Earlier : Time; + Later : Time; + Leaps_Dur : Duration; + Negate : Boolean; + Next_Leap : Time; + Secs_Diff : Long_Integer; + Sub_Seconds : Duration; + + begin + if Left >= Right then + Later := Left; + Earlier := Right; + Negate := False; + else + Later := Right; + Earlier := Left; + Negate := True; + end if; + + Diff := Later - Earlier; + + Cumulative_Leap_Secs (Earlier, Later, Leaps_Dur, Next_Leap); + + if Later >= Next_Leap then + Leaps_Dur := Leaps_Dur + 1.0; + end if; + + Diff := Diff - Leaps_Dur; + + declare + type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1; + for D_Int'Size use Duration'Size; + + Small_Div : constant D_Int := D_Int (1.0 / Duration'Small); + D_As_Int : D_Int; + + function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int); + function To_Duration is new Unchecked_Conversion (D_Int, Duration); + + 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 Ada.Calendar.Arithmetic; diff --git a/gcc/ada/a-calari.ads b/gcc/ada/a-calari.ads new file mode 100644 index 0000000..11c0e32 --- /dev/null +++ b/gcc/ada/a-calari.ads @@ -0,0 +1,60 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . A R I T H M E T I C -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, 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. -- +-- -- +------------------------------------------------------------------------------ + +package Ada.Calendar.Arithmetic is + + -- Arithmetic on days: + + type Day_Count is range + -(366 * (1 + Year_Number'Last - Year_Number'First)) + .. + +(366 * (1 + Year_Number'Last - Year_Number'First)); + + subtype Leap_Seconds_Count is Integer range -2047 .. 2047; + + procedure Difference + (Left, Right : Time; + Days : out Day_Count; + Seconds : out Duration; + Leap_Seconds : out Leap_Seconds_Count); + + function "+" (Left : Time; Right : Day_Count) return Time; + function "+" (Left : Day_Count; Right : Time) return Time; + function "-" (Left : Time; Right : Day_Count) return Time; + function "-" (Left, Right : Time) return Day_Count; + +end Ada.Calendar.Arithmetic; diff --git a/gcc/ada/a-calend-mingw.adb b/gcc/ada/a-calend-mingw.adb deleted file mode 100644 index 0ec1ca9..0000000 --- a/gcc/ada/a-calend-mingw.adb +++ /dev/null @@ -1,397 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- A D A . C A L E N D A R -- --- -- --- B o d y -- --- -- --- Copyright (C) 1997-2005, 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 is the Windows NT/95 version - --- Why do we need separate version ??? --- Do we need *this* much code duplication??? - -with System.OS_Primitives; --- used for Clock - -with System.OS_Interface; - -package body Ada.Calendar is - - use System.OS_Interface; - - ------------------------------ - -- Use of Pragma Unsuppress -- - ------------------------------ - - -- This implementation of Calendar takes advantage of the permission in - -- Ada 95 of using arithmetic overflow checks to check for out of bounds - -- time values. This means that we must catch the constraint error that - -- results from arithmetic overflow, so we use pragma Unsuppress to make - -- sure that overflow is enabled, using software overflow checking if - -- necessary. That way, compiling Calendar with options to suppress this - -- checking will not affect its correctness. - - ------------------------ - -- Local Declarations -- - ------------------------ - - Ada_Year_Min : constant := 1901; - Ada_Year_Max : constant := 2099; - - -- Win32 time constants - - epoch_1970 : constant := 16#19D_B1DE_D53E_8000#; -- win32 UTC epoch - system_time_ns : constant := 100; -- 100 ns per tick - Sec_Unit : constant := 10#1#E9; - - --------- - -- "+" -- - --------- - - function "+" (Left : Time; Right : Duration) return Time is - pragma Unsuppress (Overflow_Check); - begin - return (Left + Time (Right)); - - exception - when Constraint_Error => - raise Time_Error; - end "+"; - - function "+" (Left : Duration; Right : Time) return Time is - pragma Unsuppress (Overflow_Check); - begin - return (Time (Left) + Right); - - exception - when Constraint_Error => - raise Time_Error; - end "+"; - - --------- - -- "-" -- - --------- - - function "-" (Left : Time; Right : Duration) return Time is - pragma Unsuppress (Overflow_Check); - begin - return Left - Time (Right); - - exception - when Constraint_Error => - raise Time_Error; - end "-"; - - function "-" (Left : Time; Right : Time) return Duration is - pragma Unsuppress (Overflow_Check); - begin - return Duration (Left) - Duration (Right); - - exception - when Constraint_Error => - raise Time_Error; - end "-"; - - --------- - -- "<" -- - --------- - - function "<" (Left, Right : Time) return Boolean is - begin - return Duration (Left) < Duration (Right); - end "<"; - - ---------- - -- "<=" -- - ---------- - - function "<=" (Left, Right : Time) return Boolean is - begin - return Duration (Left) <= Duration (Right); - end "<="; - - --------- - -- ">" -- - --------- - - function ">" (Left, Right : Time) return Boolean is - begin - return Duration (Left) > Duration (Right); - end ">"; - - ---------- - -- ">=" -- - ---------- - - function ">=" (Left, Right : Time) return Boolean is - begin - return Duration (Left) >= Duration (Right); - end ">="; - - ----------- - -- Clock -- - ----------- - - -- The Ada.Calendar.Clock function gets the time from the soft links - -- interface which will call the appropriate function depending wether - -- tasking is involved or not. - - function Clock return Time is - begin - return Time (System.OS_Primitives.Clock); - end Clock; - - --------- - -- Day -- - --------- - - function Day (Date : Time) return Day_Number is - DY : Year_Number; - DM : Month_Number; - DD : Day_Number; - DS : Day_Duration; - begin - Split (Date, DY, DM, DD, DS); - return DD; - end Day; - - ----------- - -- Month -- - ----------- - - function Month (Date : Time) return Month_Number is - DY : Year_Number; - DM : Month_Number; - DD : Day_Number; - DS : Day_Duration; - - begin - Split (Date, DY, DM, DD, DS); - return DM; - end Month; - - ------------- - -- Seconds -- - ------------- - - function Seconds (Date : Time) return Day_Duration is - DY : Year_Number; - DM : Month_Number; - DD : Day_Number; - DS : Day_Duration; - begin - Split (Date, DY, DM, DD, DS); - return DS; - end Seconds; - - ----------- - -- Split -- - ----------- - - procedure Split - (Date : Time; - Year : out Year_Number; - Month : out Month_Number; - Day : out Day_Number; - Seconds : out Day_Duration) - is - - Date_Int : aliased Long_Long_Integer; - Date_Loc : aliased Long_Long_Integer; - Timbuf : aliased SYSTEMTIME; - Int_Date : Long_Long_Integer; - Sub_Seconds : Duration; - - begin - -- We take the sub-seconds (decimal part) of Date and this is added - -- to compute the Seconds. This way we keep the precision of the - -- high-precision clock that was lost with the Win32 API calls - -- below. - - if Date < 0.0 then - - -- this is a Date before Epoch (January 1st, 1970) - - Sub_Seconds := Duration (Date) - - Duration (Long_Long_Integer (Date + Duration'(0.5))); - - Int_Date := Long_Long_Integer (Date - Sub_Seconds); - - -- For Date = -86400.1 we are 2 days before Epoch at 0.1 seconds - -- from day 1 before Epoch. It means that it is 23h 59m 59.9s. - -- here we adjust for that. - - if Sub_Seconds < 0.0 then - Int_Date := Int_Date - 1; - Sub_Seconds := 1.0 + Sub_Seconds; - end if; - - else - - -- this is a Date after Epoch (January 1st, 1970) - - Sub_Seconds := Duration (Date) - - Duration (Long_Long_Integer (Date - Duration'(0.5))); - - Int_Date := Long_Long_Integer (Date - Sub_Seconds); - - end if; - - -- Date_Int is the number of seconds from Epoch - - Date_Int := Long_Long_Integer - (Int_Date * Sec_Unit / system_time_ns) + epoch_1970; - - if not FileTimeToLocalFileTime (Date_Int'Access, Date_Loc'Access) then - raise Time_Error; - end if; - - if not FileTimeToSystemTime (Date_Loc'Access, Timbuf'Access) then - raise Time_Error; - end if; - - if Timbuf.wYear not in Ada_Year_Min .. Ada_Year_Max then - raise Time_Error; - end if; - - Seconds := - Duration (Timbuf.wHour) * 3_600.0 + - Duration (Timbuf.wMinute) * 60.0 + - Duration (Timbuf.wSecond) + - Sub_Seconds; - - Day := Integer (Timbuf.wDay); - Month := Integer (Timbuf.wMonth); - Year := Integer (Timbuf.wYear); - end Split; - - ------------- - -- Time_Of -- - ------------- - - function Time_Of - (Year : Year_Number; - Month : Month_Number; - Day : Day_Number; - Seconds : Day_Duration := 0.0) - return Time - is - - Timbuf : aliased SYSTEMTIME; - Now : aliased Long_Long_Integer; - Loc : aliased Long_Long_Integer; - Int_Secs : Integer; - Secs : Integer; - Add_One_Day : Boolean := False; - Date : Time; - - begin - -- The following checks are redundant with respect to the constraint - -- error checks that should normally be made on parameters, but we - -- decide to raise Constraint_Error in any case if bad values come - -- in (as a result of checks being off in the caller, or for other - -- erroneous or bounded error cases). - - if not Year 'Valid - or else not Month 'Valid - or else not Day 'Valid - or else not Seconds'Valid - then - raise Constraint_Error; - end if; - - if Seconds = 0.0 then - Int_Secs := 0; - else - Int_Secs := Integer (Seconds - 0.5); - end if; - - -- Timbuf.wMillisec is to keep the msec. We can't use that because the - -- high-resolution clock has a precision of 1 Microsecond. - -- Anyway the sub-seconds part is not needed to compute the number - -- of seconds in UTC. - - if Int_Secs = 86_400 then - Secs := 0; - Add_One_Day := True; - else - Secs := Int_Secs; - end if; - - Timbuf.wMilliseconds := 0; - Timbuf.wSecond := WORD (Secs mod 60); - Timbuf.wMinute := WORD ((Secs / 60) mod 60); - Timbuf.wHour := WORD (Secs / 3600); - Timbuf.wDay := WORD (Day); - Timbuf.wMonth := WORD (Month); - Timbuf.wYear := WORD (Year); - - if not SystemTimeToFileTime (Timbuf'Access, Loc'Access) then - raise Time_Error; - end if; - - if not LocalFileTimeToFileTime (Loc'Access, Now'Access) then - raise Time_Error; - end if; - - -- Here we have the UTC now translate UTC to Epoch time (UNIX style - -- time based on 1 january 1970) and add there the sub-seconds part. - - declare - Sub_Sec : constant Duration := Seconds - Duration (Int_Secs); - begin - Date := Time ((Now - epoch_1970) * system_time_ns / Sec_Unit) + - Sub_Sec; - end; - - if Add_One_Day then - Date := Date + Duration (86400.0); - end if; - - return Date; - end Time_Of; - - ---------- - -- Year -- - ---------- - - function Year (Date : Time) return Year_Number is - DY : Year_Number; - DM : Month_Number; - DD : Day_Number; - DS : Day_Duration; - - begin - Split (Date, DY, DM, DD, DS); - return DY; - end Year; - -begin - System.OS_Primitives.Initialize; -end Ada.Calendar; diff --git a/gcc/ada/a-calend-vms.adb b/gcc/ada/a-calend-vms.adb index 2a5c70f..67a5697 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-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, 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- -- @@ -224,7 +224,7 @@ package body Ada.Calendar is procedure Numtim ( Status : out Unsigned_Longword; Timbuf : out Unsigned_Word_Array; - Timadr : in Time); + Timadr : Time); pragma Interface (External, Numtim); @@ -256,6 +256,22 @@ package body Ada.Calendar is Year := Integer (Timbuf (1)); end Split; + ----------------------- + -- Split_With_Offset -- + ----------------------- + + procedure Split_With_Offset + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration; + Offset : out Long_Integer) + is + begin + raise Unimplemented; + end Split_With_Offset; + ------------- -- Time_Of -- ------------- @@ -270,7 +286,7 @@ package body Ada.Calendar is procedure Cvt_Vectim ( Status : out Unsigned_Longword; - Input_Time : in Unsigned_Word_Array; + Input_Time : Unsigned_Word_Array; Resultant_Time : out Time); pragma Interface (External, Cvt_Vectim); @@ -358,4 +374,43 @@ package body Ada.Calendar is return DY; end Year; + ------------------- + -- Leap_Sec_Ops -- + ------------------- + + -- The package that is used by the Ada 2005 children of Ada.Calendar: + -- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting. + + package body Leap_Sec_Ops is + + -------------------------- + -- Cumulative_Leap_Secs -- + -------------------------- + + procedure Cumulative_Leap_Secs + (Start_Date : Time; + End_Date : Time; + Leaps_Between : out Duration; + Next_Leap_Sec : out Time) + is + begin + raise Unimplemented; + end Cumulative_Leap_Secs; + + ---------------------- + -- All_Leap_Seconds -- + ---------------------- + + function All_Leap_Seconds return Duration is + begin + raise Unimplemented; + return 0.0; + end All_Leap_Seconds; + + -- Start of processing in package Leap_Sec_Ops + + begin + null; + end Leap_Sec_Ops; + end Ada.Calendar; diff --git a/gcc/ada/a-calend-vms.ads b/gcc/ada/a-calend-vms.ads index ed3c964..3f68ffb 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-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -87,6 +87,8 @@ package Ada.Calendar is Time_Error : exception; + Unimplemented : exception; + private pragma Inline (Clock); @@ -118,4 +120,66 @@ private -- Relative Time is positive, whereas relative OS_Time is negative, -- but this declaration makes for easier conversion. + -- The following package provides handling of leap seconds. It is + -- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both + -- Ada 2005 children of Ada.Calendar. + + package Leap_Sec_Ops is + + After_Last_Leap : constant Time := Time'Last; + -- Bigger by far than any leap second value. Not within range of + -- Ada.Calendar specified dates. + + procedure Cumulative_Leap_Secs + (Start_Date : Time; + End_Date : Time; + Leaps_Between : out Duration; + Next_Leap_Sec : out Time); + -- Leaps_Between is the sum of the leap seconds that have occured + -- on or after Start_Date and before (strictly before) End_Date. + -- Next_Leap_Sec represents the next leap second occurence on or + -- after End_Date. If there are no leaps seconds after End_Date, + -- After_Last_Leap is returned. This does not provide info about + -- the next leap second (pos/neg or ?). After_Last_Leap can be used + -- as End_Date to count all the leap seconds that have occured on + -- or after Start_Date. + -- + -- Important Notes: any fractional parts of Start_Date and End_Date + -- are discarded before the calculations are done. For instance: if + -- 113 seconds is a leap second (it isn't) and 113.5 is input as an + -- End_Date, the leap second at 113 will not be counted in + -- Leaps_Between, but it will be returned as Next_Leap_Sec. Thus, if + -- the caller wants to know if the End_Date is a leap second, the + -- comparison should be: + -- + -- End_Date >= Next_Leap_Sec; + -- + -- After_Last_Leap is designed so that this comparison works without + -- having to first check if Next_Leap_Sec is a valid leap second. + + function All_Leap_Seconds return Duration; + -- Returns the sum off all of the leap seoncds. + + end Leap_Sec_Ops; + + procedure Split_With_Offset + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration; + Offset : out Long_Integer); + -- Split_W_Offset has the same spec as Split with the addition of an + -- offset value which give the offset of the local time zone from UTC + -- at the input Date. This value comes for free during the implementation + -- of Split and is needed by UTC_Time_Offset. The returned Offset time + -- is straight from the C tm struct and is in seconds. If the system + -- dependent code has no way to find the offset it will return the value + -- Invalid_TZ_Offset declared below. Otherwise no checking is done, so + -- it is up to the user to check both for Invalid_TZ_Offset and otherwise + -- for a value that is acceptable. + + Invalid_TZ_Offset : Long_Integer; + pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff"); + end Ada.Calendar; diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index 5812958..02851ad 100644 --- a/gcc/ada/a-calend.adb +++ b/gcc/ada/a-calend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, 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- -- @@ -54,9 +54,10 @@ package body Ada.Calendar is -- Local Declarations -- ------------------------ - type Char_Pointer is access Character; - subtype int is Integer; + type char_Pointer is access Character; + subtype int is Integer; subtype long is Long_Integer; + type long_Pointer is access all long; -- Synonyms for C types. We don't want to get them from Interfaces.C -- because there is no point in loading that unit just for calendar. @@ -71,7 +72,7 @@ package body Ada.Calendar is tm_yday : int; -- days since January 1 (0 .. 365) tm_isdst : int; -- Daylight Savings Time flag (-1 .. +1) tm_gmtoff : long; -- offset from CUT in seconds - tm_zone : Char_Pointer; -- timezone abbreviation + tm_zone : char_Pointer; -- timezone abbreviation end record; type tm_Pointer is access all tm; @@ -80,8 +81,15 @@ package body Ada.Calendar is type time_t_Pointer is access all time_t; - procedure localtime_r (C : time_t_Pointer; res : tm_Pointer); - pragma Import (C, localtime_r, "__gnat_localtime_r"); + procedure localtime_tzoff + (C : time_t_Pointer; + res : tm_Pointer; + off : long_Pointer); + pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff"); + -- This is a lightweight wrapper around the system library localtime_r + -- function. Parameter 'off' captures the UTC offset which is either + -- retrieved from the tm struct or calculated from the 'timezone' extern + -- and the tm_isdst flag in the tm struct. function mktime (TM : tm_Pointer) return time_t; pragma Import (C, mktime); @@ -260,6 +268,24 @@ package body Ada.Calendar is Day : out Day_Number; Seconds : out Day_Duration) is + Offset : Long_Integer; + + begin + Split_With_Offset (Date, Year, Month, Day, Seconds, Offset); + 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 -- 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 @@ -273,11 +299,12 @@ package body Ada.Calendar is -- Finally the actual variables used in the computation + Adjusted_Seconds : aliased time_t; D : Duration; Frac_Sec : Duration; - Year_Val : Integer; - Adjusted_Seconds : aliased time_t; + Local_Offset : aliased long; Tm_Val : aliased tm; + Year_Val : Integer; begin -- For us a time is simply a signed duration value, so we work with @@ -331,23 +358,26 @@ package body Ada.Calendar is 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_D_Int is new Unchecked_Conversion (Duration, D_Int); function To_Duration is new Unchecked_Conversion (D_Int, Duration); + D_As_Int : constant D_Int := To_D_Int (D); + Small_Div : constant D_Int := D_Int (1.0 / Duration'Small); + begin - D_As_Int := To_D_As_Int (D); Adjusted_Seconds := time_t (D_As_Int / Small_Div); Frac_Sec := To_Duration (D_As_Int rem Small_Div); end; - localtime_r (Adjusted_Seconds'Unchecked_Access, Tm_Val'Unchecked_Access); + 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 @@ -375,7 +405,7 @@ package body Ada.Calendar is else Year := Year_Val; end if; - end Split; + end Split_With_Offset; ------------- -- Time_Of -- @@ -444,6 +474,20 @@ package body Ada.Calendar is TM_Val.tm_year := Year_Val - 1900; + -- If time is very close to UNIX epoch mktime may behave uncorrectly + -- because of the way the different time zones are handled (a date + -- after epoch in a given time zone may correspond to a GMT date + -- before epoch). Adding one day to the date (this amount is latter + -- substracted) avoids this problem. + + if Year_Val = Unix_Year_Min + and then Month = 1 + and then Day = 1 + then + TM_Val.tm_mday := TM_Val.tm_mday + 1; + Duration_Adjust := Duration_Adjust - Duration (86400.0); + end if; + -- Since we do not have information on daylight savings, rely on the -- default information. @@ -476,6 +520,186 @@ package body Ada.Calendar is return DY; end Year; + ------------------- + -- Leap_Sec_Ops -- + ------------------- + + -- The package that is used by the Ada 2005 children of Ada.Calendar: + -- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting. + + package body Leap_Sec_Ops is + + -- This package must be updated when leap seconds are added. Adding a + -- leap second requires incrementing the value of N_Leap_Secs and adding + -- the day of the new leap second to the end of Leap_Second_Dates. + + -- Elaboration of the Leap_Sec_Ops package takes care of converting the + -- Leap_Second_Dates table to a form that is better suited for the + -- procedures provided by this package (a table that would be more + -- difficult to maintain by hand). + + N_Leap_Secs : constant := 23; + + 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_Secs) of Leap_Second_Date := + ((1972, 6, 30), (1972, 12, 31), (1973, 12, 31), (1974, 12, 31), + (1975, 12, 31), (1976, 12, 31), (1977, 12, 31), (1978, 12, 31), + (1979, 12, 31), (1981, 6, 30), (1982, 6, 30), (1983, 6, 30), + (1985, 6, 30), (1987, 12, 31), (1989, 12, 31), (1990, 12, 31), + (1992, 6, 30), (1993, 6, 30), (1994, 6, 30), (1995, 12, 31), + (1997, 6, 30), (1998, 12, 31), (2005, 12, 31)); + + Leap_Second_Times : array (1 .. N_Leap_Secs) of Time; + -- This is the needed internal representation that is calculated + -- from Leap_Second_Dates during elaboration; + + -------------------------- + -- Cumulative_Leap_Secs -- + -------------------------- + + procedure Cumulative_Leap_Secs + (Start_Date : Time; + End_Date : Time; + Leaps_Between : out Duration; + Next_Leap_Sec : out Time) + is + End_T : Time; + K : Positive; + Leap_Index : Positive; + Start_Tmp : Time; + Start_T : Time; + + 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); + + begin + Next_Leap_Sec := After_Last_Leap; + + -- We want to throw away the fractional part of seconds. Before + -- proceding with this operation, make sure our working values + -- are non-negative. + + if End_Date < 0.0 then + Leaps_Between := 0.0; + return; + end if; + + if Start_Date < 0.0 then + Start_Tmp := Time (0.0); + else + Start_Tmp := Start_Date; + end if; + + if Start_Date <= Leap_Second_Times (N_Leap_Secs) then + + -- Manipulate the fixed point value as an integer, similar to + -- Ada.Calendar.Split in order to remove the fractional part + -- from the time we will work with, Start_T and End_T. + + D_As_Int := To_D_As_Int (Duration (Start_Tmp)); + D_As_Int := D_As_Int / Small_Div; + Start_T := Time (D_As_Int); + D_As_Int := To_D_As_Int (Duration (End_Date)); + D_As_Int := D_As_Int / Small_Div; + End_T := Time (D_As_Int); + + Leap_Index := 1; + loop + exit when Leap_Second_Times (Leap_Index) >= Start_T; + Leap_Index := Leap_Index + 1; + end loop; + + K := Leap_Index; + loop + exit when K > N_Leap_Secs or else + Leap_Second_Times (K) >= End_T; + K := K + 1; + end loop; + + if K <= N_Leap_Secs then + Next_Leap_Sec := Leap_Second_Times (K); + end if; + + Leaps_Between := Duration (K - Leap_Index); + else + Leaps_Between := Duration (0.0); + end if; + end Cumulative_Leap_Secs; + + ---------------------- + -- All_Leap_Seconds -- + ---------------------- + + function All_Leap_Seconds return Duration is + begin + return Duration (N_Leap_Secs); + -- Presumes each leap second is +1.0 second; + end All_Leap_Seconds; + + -- Start of processing in package Leap_Sec_Ops + + begin + declare + Days : Natural; + Is_Leap_Year : Boolean; + Years : Natural; + + Cumulative_Days_Before_Month : + constant array (Month_Number) of Natural := + (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334); + begin + for J in 1 .. N_Leap_Secs loop + Years := Leap_Second_Dates (J).Year - Unix_Year_Min; + Days := (Years / 4) * Days_In_4_Years; + Years := Years mod 4; + Is_Leap_Year := False; + + if Years = 1 then + Days := Days + 365; + + elsif Years = 2 then + Is_Leap_Year := True; + + -- 1972 or multiple of 4 after + + Days := Days + 365 * 2; + + elsif Years = 3 then + Days := Days + 365 * 3 + 1; + end if; + + Days := Days + Cumulative_Days_Before_Month + (Leap_Second_Dates (J).Month); + + if Is_Leap_Year + and then Leap_Second_Dates (J).Month > 2 + then + Days := Days + 1; + end if; + + Days := Days + Leap_Second_Dates (J).Day; + + Leap_Second_Times (J) := + Time (Days * Duration (86_400.0) + Duration (J - 1)); + + -- Add one to get to the leap second. Add J - 1 previous + -- leap seconds. + + end loop; + end; + end Leap_Sec_Ops; + begin System.OS_Primitives.Initialize; end Ada.Calendar; diff --git a/gcc/ada/a-calend.ads b/gcc/ada/a-calend.ads index a394e2b..9f4e66a 100644 --- a/gcc/ada/a-calend.ads +++ b/gcc/ada/a-calend.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -127,4 +127,66 @@ private type Time is new Duration; + -- The following package provides handling of leap seconds. It is + -- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both + -- Ada 2005 children of Ada.Calendar. + + package Leap_Sec_Ops is + + After_Last_Leap : constant Time := Time'Last; + -- Bigger by far than any leap second value. Not within range of + -- Ada.Calendar specified dates. + + procedure Cumulative_Leap_Secs + (Start_Date : Time; + End_Date : Time; + Leaps_Between : out Duration; + Next_Leap_Sec : out Time); + -- Leaps_Between is the sum of the leap seconds that have occured + -- on or after Start_Date and before (strictly before) End_Date. + -- Next_Leap_Sec represents the next leap second occurence on or + -- after End_Date. If there are no leaps seconds after End_Date, + -- After_Last_Leap is returned. This does not provide info about + -- the next leap second (pos/neg or ?). After_Last_Leap can be used + -- as End_Date to count all the leap seconds that have occured on + -- or after Start_Date. + -- + -- Important Notes: any fractional parts of Start_Date and End_Date + -- are discarded before the calculations are done. For instance: if + -- 113 seconds is a leap second (it isn't) and 113.5 is input as an + -- End_Date, the leap second at 113 will not be counted in + -- Leaps_Between, but it will be returned as Next_Leap_Sec. Thus, if + -- the caller wants to know if the End_Date is a leap second, the + -- comparison should be: + -- + -- End_Date >= Next_Leap_Sec; + -- + -- After_Last_Leap is designed so that this comparison works without + -- having to first check if Next_Leap_Sec is a valid leap second. + + function All_Leap_Seconds return Duration; + -- Returns the sum off all of the leap seoncds. + + end Leap_Sec_Ops; + + procedure Split_With_Offset + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration; + Offset : out Long_Integer); + -- Split_W_Offset has the same spec as Split with the addition of an + -- offset value which give the offset of the local time zone from UTC + -- at the input Date. This value comes for free during the implementation + -- of Split and is needed by UTC_Time_Offset. The returned Offset time + -- is straight from the C tm struct and is in seconds. If the system + -- dependent code has no way to find the offset it will return the value + -- Invalid_TZ_Offset declared below. Otherwise no checking is done, so + -- it is up to the user to check both for Invalid_TZ_Offset and otherwise + -- for a value that is acceptable. + + Invalid_TZ_Offset : Long_Integer; + pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff"); + end Ada.Calendar; diff --git a/gcc/ada/a-calfor.adb b/gcc/ada/a-calfor.adb new file mode 100644 index 0000000..23d2ab5 --- /dev/null +++ b/gcc/ada/a-calfor.adb @@ -0,0 +1,1135 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . F O R M A T T I N G -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2006, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, 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 Ada.Calendar; use Ada.Calendar; +with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones; +with Unchecked_Conversion; + +package body Ada.Calendar.Formatting is + + use Leap_Sec_Ops; + + Days_In_4_Years : constant := 365 * 3 + 366; + Seconds_In_Day : constant := 86_400; + Seconds_In_4_Years : constant := Days_In_4_Years * Seconds_In_Day; + Seconds_In_Non_Leap_Year : constant := 365 * Seconds_In_Day; + + -- Exact time bounds for the range of Ada time: January 1, 1901 - + -- December 31, 2099. These bounds are based on the Unix Time of Epoc, + -- January 1, 1970. Start of Time is -69 years from TOE while End of + -- time is +130 years and one second from TOE. + + Start_Of_Time : constant Time := + Time (-(17 * Seconds_In_4_Years + + Seconds_In_Non_Leap_Year)); + + End_Of_Time : constant Time := + Time (32 * Seconds_In_4_Years + + 2 * Seconds_In_Non_Leap_Year) + + All_Leap_Seconds; + + Days_In_Month : constant array (Month_Number) of Day_Number := + (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); + + procedure Check_Char (S : String; C : Character; Index : Integer); + -- Subsidiary to the two versions of Value. Determine whether the + -- input strint S has character C at position Index. Raise + -- Constraint_Error if there is a mismatch. + + procedure Check_Digit (S : String; Index : Integer); + -- Subsidiary to the two versions of Value. Determine whether the + -- character of string S at position Index is a digit. This catches + -- invalid input such as 1983-*1-j3 u5:n7:k9 which should be + -- 1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch. + + ---------------- + -- Check_Char -- + ---------------- + + procedure Check_Char (S : String; C : Character; Index : Integer) is + begin + if S (Index) /= C then + raise Constraint_Error; + end if; + end Check_Char; + + ----------------- + -- Check_Digit -- + ----------------- + + procedure Check_Digit (S : String; Index : Integer) is + begin + if S (Index) not in '0' .. '9' then + raise Constraint_Error; + end if; + end Check_Digit; + + --------- + -- Day -- + --------- + + function Day + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number + is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + return Day; + end Day; + + ----------------- + -- Day_Of_Week -- + ----------------- + + function Day_Of_Week (Date : Time) return Day_Name is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + D : Duration; + Day_Count : Long_Long_Integer; + Midday_Date : Time; + Secs_Count : Long_Long_Integer; + + begin + -- Split the Date to obtain the year, month and day, then build a time + -- value for the middle of the same day, so that we don't have to worry + -- about leap seconds in the subsequent arithmetic. + + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second); + + Midday_Date := Time_Of (Year, Month, Day, 12, 0, 0); + D := Midday_Date - Start_Of_Time; + + -- D is a positive Duration value counting seconds since 1901. Convert + -- it into an integer for ease of arithmetic. + + declare + type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1; + for D_Int'Size use Duration'Size; + + function To_D_Int is new Unchecked_Conversion (Duration, D_Int); + + D_As_Int : constant D_Int := To_D_Int (D); + Small_Div : constant D_Int := D_Int (1.0 / Duration'Small); + + begin + Secs_Count := Long_Long_Integer (D_As_Int / Small_Div); + end; + + Day_Count := Secs_Count / Seconds_In_Day; + Day_Count := Day_Count + 1; -- Jan 1, 1901 was a Tuesday; + + return Day_Name'Val (Day_Count mod 7); + end Day_Of_Week; + + ---------- + -- Hour -- + ---------- + + function Hour + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number + is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + return Hour; + end Hour; + + ----------- + -- Image -- + ----------- + + function Image + (Elapsed_Time : Duration; + Include_Time_Fraction : Boolean := False) return String + is + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + SS_Nat : Natural; + + Result : String := "00:00:00.00"; + + begin + Split (Elapsed_Time, Hour, Minute, Second, Sub_Second); + SS_Nat := Natural (Sub_Second * 100.0); + + declare + Hour_Str : constant String := Hour_Number'Image (Hour); + Minute_Str : constant String := Minute_Number'Image (Minute); + Second_Str : constant String := Second_Number'Image (Second); + SS_Str : constant String := Natural'Image (SS_Nat); + + begin + -- Hour processing, positions 1 and 2 + + if Hour < 10 then + Result (2) := Hour_Str (2); + else + Result (1) := Hour_Str (2); + Result (2) := Hour_Str (3); + end if; + + -- Minute processing, positions 4 and 5 + + if Minute < 10 then + Result (5) := Minute_Str (2); + else + Result (4) := Minute_Str (2); + Result (5) := Minute_Str (3); + end if; + + -- Second processing, positions 7 and 8 + + if Second < 10 then + Result (8) := Second_Str (2); + else + Result (7) := Second_Str (2); + Result (8) := Second_Str (3); + end if; + + -- Optional sub second processing, positions 10 and 11 + + if Include_Time_Fraction then + if SS_Nat < 10 then + Result (11) := SS_Str (2); + else + Result (10) := SS_Str (2); + Result (11) := SS_Str (3); + end if; + + return Result; + else + return Result (1 .. 8); + end if; + end; + end Image; + + ----------- + -- Image -- + ----------- + + function Image + (Date : Time; + Include_Time_Fraction : Boolean := False; + Time_Zone : Time_Zones.Time_Offset := 0) return String + is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + SS_Nat : Natural; + Leap_Second : Boolean; + + Result : String := "0000-00-00 00:00:00.00"; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + + SS_Nat := Natural (Sub_Second * 100.0); + + declare + Year_Str : constant String := Year_Number'Image (Year); + Month_Str : constant String := Month_Number'Image (Month); + Day_Str : constant String := Day_Number'Image (Day); + Hour_Str : constant String := Hour_Number'Image (Hour); + Minute_Str : constant String := Minute_Number'Image (Minute); + Second_Str : constant String := Second_Number'Image (Second); + SS_Str : constant String := Natural'Image (SS_Nat); + + begin + -- Year processing, positions 1, 2, 3 and 4 + + Result (1) := Year_Str (2); + Result (2) := Year_Str (3); + Result (3) := Year_Str (4); + Result (4) := Year_Str (5); + + -- Month processing, positions 6 and 7 + + if Month < 10 then + Result (7) := Month_Str (2); + else + Result (6) := Month_Str (2); + Result (7) := Month_Str (3); + end if; + + -- Day processing, positions 9 and 10 + + if Day < 10 then + Result (10) := Day_Str (2); + else + Result (9) := Day_Str (2); + Result (10) := Day_Str (3); + end if; + + -- Hour processing, positions 12 and 13 + + if Hour < 10 then + Result (13) := Hour_Str (2); + else + Result (12) := Hour_Str (2); + Result (13) := Hour_Str (3); + end if; + + -- Minute processing, positions 15 and 16 + + if Minute < 10 then + Result (16) := Minute_Str (2); + else + Result (15) := Minute_Str (2); + Result (16) := Minute_Str (3); + end if; + + -- Second processing, positions 18 and 19 + + if Second < 10 then + Result (19) := Second_Str (2); + else + Result (18) := Second_Str (2); + Result (19) := Second_Str (3); + end if; + + -- Optional sub second processing, positions 21 and 22 + + if Include_Time_Fraction then + if SS_Nat < 10 then + Result (22) := SS_Str (2); + else + Result (21) := SS_Str (2); + Result (22) := SS_Str (3); + end if; + + return Result; + else + return Result (1 .. 19); + end if; + end; + end Image; + + ------------ + -- Minute -- + ------------ + + function Minute + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number + is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + return Minute; + end Minute; + + ----------- + -- Month -- + ----------- + + function Month + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number + is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + return Month; + end Month; + + ------------ + -- Second -- + ------------ + + function Second (Date : Time) return Second_Number is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second); + return Second; + end Second; + + ---------------- + -- Seconds_Of -- + ---------------- + + function Seconds_Of + (Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number := 0; + Sub_Second : Second_Duration := 0.0) return Day_Duration is + + begin + -- Validity checks + + if not Hour'Valid + or else not Minute'Valid + or else not Second'Valid + or else not Sub_Second'Valid + then + raise Constraint_Error; + end if; + + return Day_Duration (Hour * 3600) + + Day_Duration (Minute * 60) + + Day_Duration (Second) + + Sub_Second; + end Seconds_Of; + + ----------- + -- Split -- + ----------- + + procedure Split + (Seconds : Day_Duration; + Hour : out Hour_Number; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration) + is + Secs : Natural; + + begin + -- Validity checks + + if not Seconds'Valid then + raise Constraint_Error; + end if; + + if Seconds = 0.0 then + Secs := 0; + else + Secs := Natural (Seconds - 0.5); + end if; + + Sub_Second := Second_Duration (Seconds - Day_Duration (Secs)); + Hour := Hour_Number (Secs / 3600); + Secs := Secs mod 3600; + Minute := Minute_Number (Secs / 60); + Second := Second_Number (Secs mod 60); + end Split; + + ----------- + -- Split -- + ----------- + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration; + Leap_Second : out Boolean; + Time_Zone : Time_Zones.Time_Offset := 0) + is + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + + Seconds := Seconds_Of (Hour, Minute, Second, Sub_Second); + end Split; + + ----------- + -- Split -- + ----------- + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Hour : out Hour_Number; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration; + Time_Zone : Time_Zones.Time_Offset := 0) + is + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + end Split; + + ----------- + -- Split -- + ----------- + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Hour : out Hour_Number; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration; + Leap_Second : out Boolean; + Time_Zone : Time_Zones.Time_Offset := 0) + is + Ada_Year_Min : constant Year_Number := Year_Number'First; + Day_In_Year : Integer; + Day_Second : Integer; + Elapsed_Leaps : Duration; + Hour_Second : Integer; + In_Leap_Year : Boolean; + Modified_Date : Time; + Next_Leap : Time; + Remaining_Years : Integer; + Seconds_Count : Long_Long_Integer; + + begin + -- Our measurement of time is the number of seconds that have elapsed + -- since the Unix TOE. To calculate a UTC date from this we do a + -- sequence of divides and mods to get the components of a date based + -- on 86,400 seconds in each day. Since, UTC time depends upon the + -- occasional insertion of leap seconds, the number of leap seconds + -- that have been added prior to the input time are then subtracted + -- from the previous calculation. In fact, it is easier to do the + -- subtraction first, so a more accurate discription of what is + -- actually done, is that the number of added leap seconds is looked + -- up using the input Time value, than that number of seconds is + -- subtracted before the sequence of divides and mods. + -- + -- If the input date turns out to be a leap second, we don't add it to + -- date (we want to return 23:59:59) but we set the Leap_Second output + -- to true. + + -- Is there a need to account for a difference from Unix time prior + -- to the first leap second ??? + + -- Step 1: Determine the number of leap seconds since the start + -- of Ada time and the input date as well as the next leap second + -- occurence and process accordingly. + + Cumulative_Leap_Secs (Start_Of_Time, Date, Elapsed_Leaps, Next_Leap); + + Leap_Second := Date >= Next_Leap; + Modified_Date := Date - Elapsed_Leaps; + + if Leap_Second then + Modified_Date := Modified_Date - Duration (1.0); + end if; + + -- Step 2: Process the time zone + + Modified_Date := Modified_Date + Duration (Time_Zone * 60); + + -- Step 3: Sanity check on the calculated date. Since the leap + -- seconds and the time zone have been eliminated, the result needs + -- to be within the range of Ada time. + + if Modified_Date < Start_Of_Time + or else Modified_Date >= (End_Of_Time - All_Leap_Seconds) + then + raise Time_Error; + end if; + + Modified_Date := Modified_Date - Start_Of_Time; + + declare + type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1; + for D_Int'Size use Duration'Size; + + function To_D_Int is new Unchecked_Conversion (Duration, D_Int); + function To_Duration is new Unchecked_Conversion (D_Int, Duration); + function To_Duration is new Unchecked_Conversion (Time, Duration); + + D_As_Int : constant D_Int := To_D_Int (To_Duration (Modified_Date)); + Small_Div : constant D_Int := D_Int (1.0 / Duration'Small); + + begin + Seconds_Count := Long_Long_Integer (D_As_Int / Small_Div); + Sub_Second := Second_Duration + (To_Duration (D_As_Int rem Small_Div)); + end; + + -- Step 4: Calculate the number of years since the start of Ada time. + -- First consider sequences of four years, then the remaining years. + + Year := Ada_Year_Min + 4 * Integer (Seconds_Count / Seconds_In_4_Years); + Seconds_Count := Seconds_Count mod Seconds_In_4_Years; + Remaining_Years := Integer (Seconds_Count / Seconds_In_Non_Leap_Year); + + if Remaining_Years > 3 then + Remaining_Years := 3; + end if; + + Year := Year + Remaining_Years; + + -- Remove the seconds elapsed in those remaining years + + Seconds_Count := Seconds_Count - Long_Long_Integer + (Remaining_Years * Seconds_In_Non_Leap_Year); + In_Leap_Year := (Year mod 4) = 0; + + -- Step 5: Month and day processing. Determine the day to which the + -- remaining seconds map to. + + Day_In_Year := Integer (Seconds_Count / Seconds_In_Day) + 1; + + Month := 1; + + if Day_In_Year > 31 then + Month := 2; + Day_In_Year := Day_In_Year - 31; + + if Day_In_Year > 28 + and then ((not In_Leap_Year) + or else Day_In_Year > 29) + then + Month := 3; + Day_In_Year := Day_In_Year - 28; + + if In_Leap_Year then + Day_In_Year := Day_In_Year - 1; + end if; + + while Day_In_Year > Days_In_Month (Month) loop + Day_In_Year := Day_In_Year - Days_In_Month (Month); + Month := Month + 1; + end loop; + end if; + end if; + + -- Step 6: Hour, minute and second processing + + Day := Day_In_Year; + Day_Second := Integer (Seconds_Count mod Seconds_In_Day); + Hour := Day_Second / 3600; + Hour_Second := Day_Second mod 3600; + Minute := Hour_Second / 60; + Second := Hour_Second mod 60; + end Split; + + ---------------- + -- Sub_Second -- + ---------------- + + function Sub_Second (Date : Time) return Second_Duration is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second); + + return Sub_Second; + end Sub_Second; + + ------------- + -- Time_Of -- + ------------- + + function Time_Of + (Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Seconds : Day_Duration := 0.0; + Leap_Second : Boolean := False; + Time_Zone : Time_Zones.Time_Offset := 0) return Time + is + Hour : Hour_Number; + Minute : Minute_Number; + Sec_Num : Second_Number; + Sub_Sec : Second_Duration; + Whole_Part : Integer; + + begin + if not Seconds'Valid then + raise Constraint_Error; + end if; + + -- The fact that Seconds can go to 86,400 creates all this extra work. + -- Perhaps a Time_Of just like the next one but allowing the Second_ + -- Number input to reach 60 should become an internal version that this + -- and the next version call.... but for now we do the ugly bumping up + -- of Day, Month and Year; + + if Seconds = 86_400.0 then + declare + Adj_Year : Year_Number := Year; + Adj_Month : Month_Number := Month; + Adj_Day : Day_Number := Day; + + begin + Hour := 0; + Minute := 0; + Sec_Num := 0; + Sub_Sec := 0.0; + + if Day < Days_In_Month (Month) + or else (Month = 2 + and then Year mod 4 = 0) + then + Adj_Day := Day + 1; + else + Adj_Day := 1; + + if Month < 12 then + Adj_Month := Month + 1; + else + Adj_Month := 1; + Adj_Year := Year + 1; + end if; + end if; + + return Time_Of (Adj_Year, Adj_Month, Adj_Day, Hour, Minute, + Sec_Num, Sub_Sec, Leap_Second, Time_Zone); + end; + end if; + + declare + type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1; + for D_Int'Size use Duration'Size; + + function To_D_Int is new Unchecked_Conversion (Duration, D_Int); + function To_Duration is new Unchecked_Conversion (D_Int, Duration); + + D_As_Int : constant D_Int := To_D_Int (Seconds); + Small_Div : constant D_Int := D_Int (1.0 / Duration'Small); + + begin + Whole_Part := Integer (D_As_Int / Small_Div); + Sub_Sec := Second_Duration + (To_Duration (D_As_Int rem Small_Div)); + end; + + Hour := Hour_Number (Whole_Part / 3600); + Whole_Part := Whole_Part mod 3600; + Minute := Minute_Number (Whole_Part / 60); + Sec_Num := Second_Number (Whole_Part mod 60); + + return Time_Of (Year, Month, Day, + Hour, Minute, Sec_Num, Sub_Sec, Leap_Second, Time_Zone); + end Time_Of; + + ------------- + -- Time_Of -- + ------------- + + function Time_Of + (Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration := 0.0; + Leap_Second : Boolean := False; + Time_Zone : Time_Zones.Time_Offset := 0) return Time + is + Cumulative_Days_Before_Month : + constant array (Month_Number) of Natural := + (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334); + + Ada_Year_Min : constant Year_Number := Year_Number'First; + Count : Integer; + Elapsed_Leap_Seconds : Duration; + Fractional_Second : Duration; + Next_Leap : Time; + Result : Time; + + begin + -- The following checks are redundant with respect to the constraint + -- error checks that should normally be made on parameters, but we + -- decide to raise Constraint_Error in any case if bad values come in + -- (as a result of checks being off in the caller, or for other + -- erroneous or bounded error cases). + + if not Year'Valid + or else not Month'Valid + or else not Day'Valid + or else not Hour'Valid + or else not Minute'Valid + or else not Second'Valid + or else not Sub_Second'Valid + or else not Time_Zone'Valid + then + raise Constraint_Error; + end if; + + -- Start the accumulation from the beginning of Ada time + + Result := Start_Of_Time; + + -- Step 1: Determine the number of leap and non-leap years since 1901 + -- and the input date. + + -- Count the number of four year segments + + Count := (Year - Ada_Year_Min) / 4; + Result := Result + Duration (Count * Seconds_In_4_Years); + + -- Count the number of remaining non-leap years + + Count := (Year - Ada_Year_Min) mod 4; + Result := Result + Duration (Count * Seconds_In_Non_Leap_Year); + + -- Step 2: Determine the number of days elapsed singe the start of the + -- input year and add them to the result. + + -- Do not include the current day since it is not over yet + + Count := Cumulative_Days_Before_Month (Month) + Day - 1; + + -- The input year is a leap year and we have passed February + + if (Year mod 4) = 0 + and then Month > 2 + then + Count := Count + 1; + end if; + + Result := Result + Duration (Count * Seconds_In_Day); + + -- Step 3: Hour, minute and second processing + + Result := Result + Duration (Hour * 3600) + + Duration (Minute * 60) + + Duration (Second); + + -- The sub second may designate a whole second + + if Sub_Second = 1.0 then + Result := Result + Duration (1.0); + Fractional_Second := 0.0; + else + Fractional_Second := Sub_Second; + end if; + + -- Step 4: Time zone processing + + Result := Result - Duration (Time_Zone * 60); + + -- Step 5: The caller wants a leap second + + if Leap_Second then + Result := Result + Duration (1.0); + end if; + + -- Step 6: Calculate the number of leap seconds occured since the + -- start of Ada time and the current point in time. The following + -- is an approximation which does not yet count leap seconds. It + -- can be pushed beyond 1 leap second, but not more. + + Cumulative_Leap_Secs + (Start_Of_Time, Result, Elapsed_Leap_Seconds, Next_Leap); + + Result := Result + Elapsed_Leap_Seconds; + + -- Step 7: Validity check of a leap second occurence. It requires an + -- additional comparison to Next_Leap to ensure that we landed right + -- on a valid occurence and that Elapsed_Leap_Seconds did not shoot + -- past it. + + if Leap_Second + and then + not (Result >= Next_Leap + and then Result - Duration (1.0) < Next_Leap) + then + raise Time_Error; + end if; + + -- Step 8: Final sanity check on the calculated duration value + + if Result < Start_Of_Time + or else Result >= End_Of_Time + then + raise Time_Error; + end if; + + -- Step 9: Lastly, add the sub second part + + return Result + Fractional_Second; + end Time_Of; + + ----------- + -- Value -- + ----------- + + function Value + (Date : String; + Time_Zone : Time_Zones.Time_Offset := 0) return Time + is + D : String (1 .. 22); + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration := 0.0; + + begin + -- Validity checks + + if not Time_Zone'Valid then + raise Constraint_Error; + end if; + + -- Length checks + + if Date'Length /= 19 + and then Date'Length /= 22 + then + raise Constraint_Error; + end if; + + -- After the correct length has been determined, it is safe to + -- copy the Date in order to avoid Date'First + N indexing. + + D (1 .. Date'Length) := Date; + + -- Format checks + + Check_Char (D, '-', 5); + Check_Char (D, '-', 8); + Check_Char (D, ' ', 11); + Check_Char (D, ':', 14); + Check_Char (D, ':', 17); + + if Date'Length = 22 then + Check_Char (D, '.', 20); + end if; + + -- Leading zero checks + + Check_Digit (D, 6); + Check_Digit (D, 9); + Check_Digit (D, 12); + Check_Digit (D, 15); + Check_Digit (D, 18); + + if Date'Length = 22 then + Check_Digit (D, 21); + end if; + + -- Value extraction + + Year := Year_Number (Year_Number'Value (D (1 .. 4))); + Month := Month_Number (Month_Number'Value (D (6 .. 7))); + Day := Day_Number (Day_Number'Value (D (9 .. 10))); + Hour := Hour_Number (Hour_Number'Value (D (12 .. 13))); + Minute := Minute_Number (Minute_Number'Value (D (15 .. 16))); + Second := Second_Number (Second_Number'Value (D (18 .. 19))); + + -- Optional part + + if Date'Length = 22 then + Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22))); + end if; + + -- Sanity 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 Constraint_Error; + end if; + + return Time_Of (Year, Month, Day, + Hour, Minute, Second, Sub_Second, False, Time_Zone); + + exception + when others => raise Constraint_Error; + end Value; + + ----------- + -- Value -- + ----------- + + function Value (Elapsed_Time : String) return Duration is + D : String (1 .. 11); + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration := 0.0; + + begin + -- Length checks + + if Elapsed_Time'Length /= 8 + and then Elapsed_Time'Length /= 11 + then + raise Constraint_Error; + end if; + + -- After the correct length has been determined, it is safe to + -- copy the Elapsed_Time in order to avoid Date'First + N indexing. + + D (1 .. Elapsed_Time'Length) := Elapsed_Time; + + -- Format checks + + Check_Char (D, ':', 3); + Check_Char (D, ':', 6); + + if Elapsed_Time'Length = 11 then + Check_Char (D, '.', 9); + end if; + + -- Leading zero checks + + Check_Digit (D, 1); + Check_Digit (D, 4); + Check_Digit (D, 7); + + if Elapsed_Time'Length = 11 then + Check_Digit (D, 10); + end if; + + -- Value extraction + + Hour := Hour_Number (Hour_Number'Value (D (1 .. 2))); + Minute := Minute_Number (Minute_Number'Value (D (4 .. 5))); + Second := Second_Number (Second_Number'Value (D (7 .. 8))); + + -- Optional part + + if Elapsed_Time'Length = 11 then + Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11))); + end if; + + -- Sanity checks + + if not Hour'Valid + or else not Minute'Valid + or else not Second'Valid + or else not Sub_Second'Valid + then + raise Constraint_Error; + end if; + + return Seconds_Of (Hour, Minute, Second, Sub_Second); + + exception + when others => raise Constraint_Error; + end Value; + + ---------- + -- Year -- + ---------- + + function Year + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number + is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration; + Leap_Second : Boolean; + + begin + Split (Date, Year, Month, Day, + Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone); + return Year; + end Year; + +end Ada.Calendar.Formatting; diff --git a/gcc/ada/a-calfor.ads b/gcc/ada/a-calfor.ads new file mode 100644 index 0000000..89e704b --- /dev/null +++ b/gcc/ada/a-calfor.ads @@ -0,0 +1,163 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . F O R M A T T I N G -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, 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 Ada.Calendar.Time_Zones; + +package Ada.Calendar.Formatting is + + -- Day of the week + + type Day_Name is + (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday); + + function Day_Of_Week (Date : Time) return Day_Name; + + -- Hours:Minutes:Seconds access + + subtype Hour_Number is Natural range 0 .. 23; + subtype Minute_Number is Natural range 0 .. 59; + subtype Second_Number is Natural range 0 .. 59; + subtype Second_Duration is Day_Duration range 0.0 .. 1.0; + + function Year + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number; + + function Month + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number; + + function Day + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number; + + function Hour + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number; + + function Minute + (Date : Time; + Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number; + + function Second + (Date : Time) return Second_Number; + + function Sub_Second + (Date : Time) return Second_Duration; + + function Seconds_Of + (Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number := 0; + Sub_Second : Second_Duration := 0.0) return Day_Duration; + + procedure Split + (Seconds : Day_Duration; + Hour : out Hour_Number; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration); + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Hour : out Hour_Number; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration; + Time_Zone : Time_Zones.Time_Offset := 0); + + function Time_Of + (Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Hour : Hour_Number; + Minute : Minute_Number; + Second : Second_Number; + Sub_Second : Second_Duration := 0.0; + Leap_Second : Boolean := False; + Time_Zone : Time_Zones.Time_Offset := 0) return Time; + + function Time_Of + (Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Seconds : Day_Duration := 0.0; + Leap_Second : Boolean := False; + Time_Zone : Time_Zones.Time_Offset := 0) return Time; + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Hour : out Hour_Number; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration; + Leap_Second : out Boolean; + Time_Zone : Time_Zones.Time_Offset := 0); + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration; + Leap_Second : out Boolean; + Time_Zone : Time_Zones.Time_Offset := 0); + + -- Simple image and value + + function Image + (Date : Time; + Include_Time_Fraction : Boolean := False; + Time_Zone : Time_Zones.Time_Offset := 0) return String; + + function Value + (Date : String; + Time_Zone : Time_Zones.Time_Offset := 0) return Time; + + function Image + (Elapsed_Time : Duration; + Include_Time_Fraction : Boolean := False) return String; + + function Value (Elapsed_Time : String) return Duration; + +end Ada.Calendar.Formatting; diff --git a/gcc/ada/a-catizo.adb b/gcc/ada/a-catizo.adb new file mode 100644 index 0000000..8243e8b --- /dev/null +++ b/gcc/ada/a-catizo.adb @@ -0,0 +1,67 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . T I M E _ Z O N E S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2006, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, 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. -- +-- -- +------------------------------------------------------------------------------ + +package body Ada.Calendar.Time_Zones is + + --------------------- + -- UTC_Time_Offset -- + --------------------- + + function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Seconds : Day_Duration; + Offset : Long_Integer; + + begin + Split_With_Offset (Date, Year, Month, Day, Seconds, Offset); + + -- The system dependent code does not support time zones + + if Offset = Invalid_TZ_Offset then + raise Unknown_Zone_Error; + end if; + + Offset := Offset / 60; + + if Offset < Long_Integer (Time_Offset'First) + or else Offset > Long_Integer (Time_Offset'Last) + then + raise Unknown_Zone_Error; + end if; + + return Time_Offset (Offset); + end UTC_Time_Offset; + +end Ada.Calendar.Time_Zones; diff --git a/gcc/ada/a-catizo.ads b/gcc/ada/a-catizo.ads new file mode 100644 index 0000000..83907c4 --- /dev/null +++ b/gcc/ada/a-catizo.ads @@ -0,0 +1,48 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . T I M E _ Z O N E S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, 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. -- +-- -- +------------------------------------------------------------------------------ + +package Ada.Calendar.Time_Zones is + + -- Time zone manipulation + + type Time_Offset is range -(28 * 60) .. 28 * 60; + + Unknown_Zone_Error : exception; + + function UTC_Time_Offset (Date : Time := Clock) return Time_Offset; + +end Ada.Calendar.Time_Zones; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index a720a28..e849797 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -334,8 +334,10 @@ package body Impunit is -- Ada Hierarchy Units from Ada 2005 Reference Manual -- -------------------------------------------------------- + "a-calari", -- Ada.Calendar.Arithmetic + "a-calfor", -- Ada.Calendar.Formatting + "a-catizo", -- Ada.Calendar.Time_Zones "a-cdlili", -- Ada.Containers.Doubly_Linked_Lists - "a-cgaaso", -- Ada.Containers.Generic_Anonymous_Array_Sort "a-cgarso", -- Ada.Containers.Generic_Array_Sort "a-cgcaso", -- Ada.Containers.Generic_Constrained_Array_Sort "a-chacon", -- Ada.Characters.Conversions @@ -353,11 +355,10 @@ package body Impunit is "a-coorse", -- Ada.Containers.Ordered_Sets "a-coteio", -- Ada.Complex_Text_IO "a-direct", -- Ada.Directories + "a-diroro", -- Ada.Dispatching.Round_Robin + "a-dispat", -- Ada.Dispatching "a-envvar", -- Ada.Environment_Variables "a-rttiev", -- Ada.Real_Time.Timing_Events - "a-secain", -- Ada.Strings.Equal_Case_Insensitive - "a-shcain", -- Ada.Strings.Hash_Case_Insensitive - "a-slcain", -- Ada.Strings.Less_Case_Insensitive "a-stboha", -- Ada.Strings.Bounded.Hash "a-stfiha", -- Ada.Strings.Fixed.Hash "a-strhas", -- Ada.Strings.Hash @@ -383,6 +384,8 @@ package body Impunit is "a-wwboio", -- Ada.Wide_Text_IO.Wide_Bounded_IO "a-wwunio", -- Ada.Wide_Text_IO.Wide_Unbounded_IO "a-zchara", -- Ada.Wide_Wide_Characters + "a-ztcoio", -- Ada.Wide_Wide_Text_IO.Complex_IO + "a-ztedit", -- Ada.Wide_Wide_Text_IO.Editing "a-zttest", -- Ada.Wide_Wide_Text_IO.Text_Streams "a-ztexio", -- Ada.Wide_Wide_Text_IO "a-zzboio", -- Ada.Wide_Wide_Text_IO.Wide_Wide_Bounded_IO @@ -408,10 +411,15 @@ package body Impunit is -- GNAT Defined Additions to Ada 2005 -- ---------------------------------------- + "a-cgaaso", -- Ada.Containers.Generic_Anonymous_Array_Sort "a-chzla1", -- Ada.Characters.Wide_Wide_Latin_1 "a-chzla9", -- Ada.Characters.Wide_Wide_Latin_9 "a-ciormu", -- Ada.Containers.Indefinite_Ordered_Multisets "a-coormu", -- Ada.Containers.Ordered_Multisets + "a-crdlli", -- Ada.Containers.Restricted_Doubly_Linked_Lists + "a-secain", -- Ada.Strings.Equal_Case_Insensitive + "a-shcain", -- Ada.Strings.Hash_Case_Insensitive + "a-slcain", -- Ada.Strings.Less_Case_Insensitive "a-szuzti", -- Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO "a-zchuni", -- Ada.Wide_Wide_Characters.Unicode diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index 055c99f1..0562766 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -44,7 +44,6 @@ #include "tsystem.h" #include <fcntl.h> #include <sys/stat.h> -#include <time.h> #ifdef VMS #include <unixio.h> #endif @@ -53,6 +52,14 @@ #include "system.h" #endif +#include <time.h> + +#if defined (sun) && defined (__SVR4) && !defined (__vxworks) +/* The declaration is present in <time.h> but conditionalized + on a couple of macros we don't define. */ +extern struct tm *localtime_r(const time_t *, struct tm *); +#endif + #include "adaint.h" /* @@ -664,8 +671,6 @@ rts_get_nShowCmd (void) /* This gets around a problem with using the old threads library on VMS 7.0. */ -#include <time.h> - extern long get_gmtoff (void); long @@ -680,27 +685,57 @@ get_gmtoff (void) } #endif +/* This value is returned as the time zone offset when a valid value + cannot be determined. It is simply a bizarre value that will never + occur. It is 3 days plus 73 seconds (offset is in seconds. */ + +long __gnat_invalid_tzoff = 259273; + /* Definition of __gnat_locatime_r used by a-calend.adb */ -#if defined (__EMX__) +#if defined (__EMX__) || defined (__MINGW32__) + +#ifdef CERT + +/* For the Cert run times on native Windows we use dummy functions + for locking and unlocking tasks since we do not support multiple + threads on this configuration (Cert run time on native Windows). */ + +void dummy (void) {} + +void (*Lock_Task) () = &dummy; +void (*Unlock_Task) () = &dummy; + +#else + #define Lock_Task system__soft_links__lock_task extern void (*Lock_Task) (void); #define Unlock_Task system__soft_links__unlock_task extern void (*Unlock_Task) (void); -/* Provide reentrant version of localtime on OS/2. */ +#endif + +/* Reentrant localtime for Windows and OS/2. */ -extern struct tm *__gnat_localtime_r (const time_t *, struct tm *); +extern struct tm * +__gnat_localtime_tzoff (const time_t *, struct tm *, long *); struct tm * -__gnat_localtime_r (const time_t *timer, struct tm *tp) +__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off) { + DWORD dwRet; struct tm *tmp; + TIME_ZONE_INFORMATION tzi; (*Lock_Task) (); tmp = localtime (timer); memcpy (tp, tmp, sizeof (struct tm)); + dwRet = GetTimeZoneInformation (&tzi); + *off = tzi.Bias; + if (tp->tm_isdst > 0) + *off = *off + tzi.DaylightBias; + *off = *off * -60; (*Unlock_Task) (); return tp; } @@ -714,31 +749,51 @@ __gnat_localtime_r (const time_t *timer, struct tm *tp) spec is required. Only use when ___THREADS_POSIX4ad4__ is defined, the Lynx convention when building against the legacy API. */ -extern struct tm *__gnat_localtime_r (const time_t *, struct tm *); +extern struct tm * +__gnat_localtime_tzoff (const time_t *, struct tm *, long *); struct tm * -__gnat_localtime_r (const time_t *timer, struct tm *tp) +__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off) { localtime_r (tp, timer); + *off = __gnat_invalid_tzoff; return NULL; } #else -#if defined (VMS) || defined (__MINGW32__) +#if defined (VMS) -/* __gnat_localtime_r is not needed on NT and VMS */ +/* __gnat_localtime_tzoff is not needed on VMS */ #else /* All other targets provide a standard localtime_r */ -extern struct tm *__gnat_localtime_r (const time_t *, struct tm *); +extern struct tm * +__gnat_localtime_tzoff (const time_t *, struct tm *, long *); struct tm * -__gnat_localtime_r (const time_t *timer, struct tm *tp) +__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off) { - return (struct tm *) localtime_r (timer, tp); + localtime_r (timer, tp); + +/* AIX, HPUX, SGI Irix, Sun Solaris */ +#if defined (_AIX) || defined (__hpux__) || defined (sgi) || defined (sun) + *off = (long) -timezone; + if (tp->tm_isdst > 0) + *off = *off + 3600; + +/* Lynx, VXWorks */ +#elif defined (__Lynx__) || defined (__vxworks) + *off = __gnat_invalid_tzoff; + +/* Darwin, Free BSD, Linux, Tru64 */ +#else + *off = tp->tm_gmtoff; +#endif + return NULL; } + #endif #endif #endif |