diff options
Diffstat (limited to 'gcc/ada')
| -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 00000000000..de02a90ce6d --- /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 00000000000..11c0e32cbd6 --- /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 0ec1ca94a8c..00000000000 --- 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 2a5c70f6bf8..67a5697691b 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 ed3c9648458..3f68ffb6468 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 581295818e1..02851ad50b3 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 a394e2bbcaf..9f4e66a1d43 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 00000000000..23d2ab5850f --- /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 00000000000..89e704bb64b --- /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 00000000000..8243e8b9639 --- /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 00000000000..83907c48e08 --- /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 a720a2866f1..e8497974954 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 055c99f1ad8..0562766a9e5 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 |