diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/g-calend.adb')
| -rw-r--r-- | gcc-4.7/gcc/ada/g-calend.adb | 547 |
1 files changed, 0 insertions, 547 deletions
diff --git a/gcc-4.7/gcc/ada/g-calend.adb b/gcc-4.7/gcc/ada/g-calend.adb deleted file mode 100644 index 2e9f1cca6..000000000 --- a/gcc-4.7/gcc/ada/g-calend.adb +++ /dev/null @@ -1,547 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- G N A T . C A L E N D A R -- --- -- --- B o d y -- --- -- --- Copyright (C) 1999-2010, AdaCore -- --- -- --- 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 3, 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -package body GNAT.Calendar is - - use Ada.Calendar; - use Interfaces; - - ----------------- - -- Day_In_Year -- - ----------------- - - function Day_In_Year (Date : Time) return Day_In_Year_Number is - Year : Year_Number; - Month : Month_Number; - Day : Day_Number; - Day_Secs : Day_Duration; - pragma Unreferenced (Day_Secs); - begin - Split (Date, Year, Month, Day, Day_Secs); - return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1; - end Day_In_Year; - - ----------------- - -- Day_Of_Week -- - ----------------- - - function Day_Of_Week (Date : Time) return Day_Name is - Year : Year_Number; - Month : Month_Number; - Day : Day_Number; - Day_Secs : Day_Duration; - pragma Unreferenced (Day_Secs); - begin - Split (Date, Year, Month, Day, Day_Secs); - return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7); - end Day_Of_Week; - - ---------- - -- Hour -- - ---------- - - function Hour (Date : Time) 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; - pragma Unreferenced (Year, Month, Day, Minute, Second, Sub_Second); - begin - Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); - return Hour; - end Hour; - - ---------------- - -- Julian_Day -- - ---------------- - - -- Julian_Day is used to by Day_Of_Week and Day_In_Year. Note that this - -- implementation is not expensive. - - function Julian_Day - (Year : Year_Number; - Month : Month_Number; - Day : Day_Number) return Integer - is - Internal_Year : Integer; - Internal_Month : Integer; - Internal_Day : Integer; - Julian_Date : Integer; - C : Integer; - Ya : Integer; - - begin - Internal_Year := Integer (Year); - Internal_Month := Integer (Month); - Internal_Day := Integer (Day); - - if Internal_Month > 2 then - Internal_Month := Internal_Month - 3; - else - Internal_Month := Internal_Month + 9; - Internal_Year := Internal_Year - 1; - end if; - - C := Internal_Year / 100; - Ya := Internal_Year - (100 * C); - - Julian_Date := (146_097 * C) / 4 + - (1_461 * Ya) / 4 + - (153 * Internal_Month + 2) / 5 + - Internal_Day + 1_721_119; - - return Julian_Date; - end Julian_Day; - - ------------ - -- Minute -- - ------------ - - function Minute (Date : Time) 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; - pragma Unreferenced (Year, Month, Day, Hour, Second, Sub_Second); - begin - Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); - return Minute; - end Minute; - - ------------ - -- 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; - pragma Unreferenced (Year, Month, Day, Hour, Minute, Sub_Second); - begin - Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); - return Second; - end Second; - - ----------- - -- 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) - is - Day_Secs : Day_Duration; - Secs : Natural; - - begin - Split (Date, Year, Month, Day, Day_Secs); - - Secs := (if Day_Secs = 0.0 then 0 else Natural (Day_Secs - 0.5)); - Sub_Second := Second_Duration (Day_Secs - Day_Duration (Secs)); - Hour := Hour_Number (Secs / 3_600); - Secs := Secs mod 3_600; - Minute := Minute_Number (Secs / 60); - Second := Second_Number (Secs 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; - pragma Unreferenced (Year, Month, Day, Hour, Minute, Second); - begin - Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); - return Sub_Second; - end Sub_Second; - - ------------- - -- 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) return Time - is - - Day_Secs : constant Day_Duration := - Day_Duration (Hour * 3_600) + - Day_Duration (Minute * 60) + - Day_Duration (Second) + - Sub_Second; - begin - return Time_Of (Year, Month, Day, Day_Secs); - end Time_Of; - - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (T : not null access timeval) return Duration is - - procedure timeval_to_duration - (T : not null access timeval; - sec : not null access C.long; - usec : not null access C.long); - pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); - - Micro : constant := 10**6; - sec : aliased C.long; - usec : aliased C.long; - - begin - timeval_to_duration (T, sec'Access, usec'Access); - return Duration (sec) + Duration (usec) / Micro; - end To_Duration; - - ---------------- - -- To_Timeval -- - ---------------- - - function To_Timeval (D : Duration) return timeval is - - procedure duration_to_timeval - (Sec : C.long; - Usec : C.long; - T : not null access timeval); - pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval"); - - Micro : constant := 10**6; - Result : aliased timeval; - sec : C.long; - usec : C.long; - - begin - if D = 0.0 then - sec := 0; - usec := 0; - else - sec := C.long (D - 0.5); - usec := C.long ((D - Duration (sec)) * Micro - 0.5); - end if; - - duration_to_timeval (sec, usec, Result'Access); - - return Result; - end To_Timeval; - - ------------------ - -- Week_In_Year -- - ------------------ - - function Week_In_Year (Date : Time) return Week_In_Year_Number is - Year : Year_Number; - Week : Week_In_Year_Number; - pragma Unreferenced (Year); - begin - Year_Week_In_Year (Date, Year, Week); - return Week; - end Week_In_Year; - - ----------------------- - -- Year_Week_In_Year -- - ----------------------- - - procedure Year_Week_In_Year - (Date : Time; - Year : out Year_Number; - Week : out Week_In_Year_Number) - is - Month : Month_Number; - Day : Day_Number; - Hour : Hour_Number; - Minute : Minute_Number; - Second : Second_Number; - Sub_Second : Second_Duration; - Jan_1 : Day_Name; - Shift : Week_In_Year_Number; - Start_Week : Week_In_Year_Number; - - pragma Unreferenced (Hour, Minute, Second, Sub_Second); - - function Is_Leap (Year : Year_Number) return Boolean; - -- Return True if Year denotes a leap year. Leap centennial years are - -- properly handled. - - function Jan_1_Day_Of_Week - (Jan_1 : Day_Name; - Year : Year_Number; - Last_Year : Boolean := False; - Next_Year : Boolean := False) return Day_Name; - -- Given the weekday of January 1 in Year, determine the weekday on - -- which January 1 fell last year or will fall next year as set by - -- the two flags. This routine does not call Time_Of or Split. - - function Last_Year_Has_53_Weeks - (Jan_1 : Day_Name; - Year : Year_Number) return Boolean; - -- Given the weekday of January 1 in Year, determine whether last year - -- has 53 weeks. A False value implies that the year has 52 weeks. - - ------------- - -- Is_Leap -- - ------------- - - function Is_Leap (Year : Year_Number) return Boolean is - begin - if Year mod 400 = 0 then - return True; - elsif Year mod 100 = 0 then - return False; - else - return Year mod 4 = 0; - end if; - end Is_Leap; - - ----------------------- - -- Jan_1_Day_Of_Week -- - ----------------------- - - function Jan_1_Day_Of_Week - (Jan_1 : Day_Name; - Year : Year_Number; - Last_Year : Boolean := False; - Next_Year : Boolean := False) return Day_Name - is - Shift : Integer := 0; - - begin - if Last_Year then - Shift := (if Is_Leap (Year - 1) then -2 else -1); - elsif Next_Year then - Shift := (if Is_Leap (Year) then 2 else 1); - end if; - - return Day_Name'Val ((Day_Name'Pos (Jan_1) + Shift) mod 7); - end Jan_1_Day_Of_Week; - - ---------------------------- - -- Last_Year_Has_53_Weeks -- - ---------------------------- - - function Last_Year_Has_53_Weeks - (Jan_1 : Day_Name; - Year : Year_Number) return Boolean - is - Last_Jan_1 : constant Day_Name := - Jan_1_Day_Of_Week (Jan_1, Year, Last_Year => True); - - begin - -- These two cases are illustrated in the table below - - return - Last_Jan_1 = Thursday - or else (Last_Jan_1 = Wednesday and then Is_Leap (Year - 1)); - end Last_Year_Has_53_Weeks; - - -- Start of processing for Week_In_Year - - begin - Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); - - -- According to ISO 8601, the first week of year Y is the week that - -- contains the first Thursday in year Y. The following table contains - -- all possible combinations of years and weekdays along with examples. - - -- +-------+------+-------+---------+ - -- | Jan 1 | Leap | Weeks | Example | - -- +-------+------+-------+---------+ - -- | Mon | No | 52 | 2007 | - -- +-------+------+-------+---------+ - -- | Mon | Yes | 52 | 1996 | - -- +-------+------+-------+---------+ - -- | Tue | No | 52 | 2002 | - -- +-------+------+-------+---------+ - -- | Tue | Yes | 52 | 1980 | - -- +-------+------+-------+---------+ - -- | Wed | No | 52 | 2003 | - -- +-------+------#########---------+ - -- | Wed | Yes # 53 # 1992 | - -- +-------+------#-------#---------+ - -- | Thu | No # 53 # 1998 | - -- +-------+------#-------#---------+ - -- | Thu | Yes # 53 # 2004 | - -- +-------+------#########---------+ - -- | Fri | No | 52 | 1999 | - -- +-------+------+-------+---------+ - -- | Fri | Yes | 52 | 1988 | - -- +-------+------+-------+---------+ - -- | Sat | No | 52 | 1994 | - -- +-------+------+-------+---------+ - -- | Sat | Yes | 52 | 1972 | - -- +-------+------+-------+---------+ - -- | Sun | No | 52 | 1995 | - -- +-------+------+-------+---------+ - -- | Sun | Yes | 52 | 1956 | - -- +-------+------+-------+---------+ - - -- A small optimization, the input date is January 1. Note that this - -- is a key day since it determines the number of weeks and is used - -- when special casing the first week of January and the last week of - -- December. - - Jan_1 := Day_Of_Week (if Day = 1 and then Month = 1 - then Date - else (Time_Of (Year, 1, 1, 0.0))); - - -- Special cases for January - - if Month = 1 then - - -- Special case 1: January 1, 2 and 3. These three days may belong - -- to last year's last week which can be week number 52 or 53. - - -- +-----+-----+-----+=====+-----+-----+-----+ - -- | Mon | Tue | Wed # Thu # Fri | Sat | Sun | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 26 | 27 | 28 # 29 # 30 | 31 | 1 | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 27 | 28 | 29 # 30 # 31 | 1 | 2 | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 28 | 29 | 30 # 31 # 1 | 2 | 3 | - -- +-----+-----+-----+=====+-----+-----+-----+ - - if (Day = 1 and then Jan_1 in Friday .. Sunday) - or else - (Day = 2 and then Jan_1 in Friday .. Saturday) - or else - (Day = 3 and then Jan_1 = Friday) - then - Week := (if Last_Year_Has_53_Weeks (Jan_1, Year) then 53 else 52); - - -- January 1, 2 and 3 belong to the previous year - - Year := Year - 1; - return; - - -- Special case 2: January 1, 2, 3, 4, 5, 6 and 7 of the first week - - -- +-----+-----+-----+=====+-----+-----+-----+ - -- | Mon | Tue | Wed # Thu # Fri | Sat | Sun | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 29 | 30 | 31 # 1 # 2 | 3 | 4 | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 30 | 31 | 1 # 2 # 3 | 4 | 5 | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 31 | 1 | 2 # 3 # 4 | 5 | 6 | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 1 | 2 | 3 # 4 # 5 | 6 | 7 | - -- +-----+-----+-----+=====+-----+-----+-----+ - - elsif (Day <= 4 and then Jan_1 in Monday .. Thursday) - or else - (Day = 5 and then Jan_1 in Monday .. Wednesday) - or else - (Day = 6 and then Jan_1 in Monday .. Tuesday) - or else - (Day = 7 and then Jan_1 = Monday) - then - Week := 1; - return; - end if; - - -- Month other than 1 - - -- Special case 3: December 29, 30 and 31. These days may belong to - -- next year's first week. - - -- +-----+-----+-----+=====+-----+-----+-----+ - -- | Mon | Tue | Wed # Thu # Fri | Sat | Sun | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 29 | 30 | 31 # 1 # 2 | 3 | 4 | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 30 | 31 | 1 # 2 # 3 | 4 | 5 | - -- +-----+-----+-----+-----+-----+-----+-----+ - -- | 31 | 1 | 2 # 3 # 4 | 5 | 6 | - -- +-----+-----+-----+=====+-----+-----+-----+ - - elsif Month = 12 and then Day > 28 then - declare - Next_Jan_1 : constant Day_Name := - Jan_1_Day_Of_Week (Jan_1, Year, Next_Year => True); - begin - if (Day = 29 and then Next_Jan_1 = Thursday) - or else - (Day = 30 and then Next_Jan_1 in Wednesday .. Thursday) - or else - (Day = 31 and then Next_Jan_1 in Tuesday .. Thursday) - then - Year := Year + 1; - Week := 1; - return; - end if; - end; - end if; - - -- Determine the week from which to start counting. If January 1 does - -- not belong to the first week of the input year, then the next week - -- is the first week. - - Start_Week := (if Jan_1 in Friday .. Sunday then 1 else 2); - - -- At this point all special combinations have been accounted for and - -- the proper start week has been found. Since January 1 may not fall - -- on a Monday, shift 7 - Day_Name'Pos (Jan_1). This action ensures an - -- origin which falls on Monday. - - Shift := 7 - Day_Name'Pos (Jan_1); - Week := Start_Week + (Day_In_Year (Date) - Shift - 1) / 7; - end Year_Week_In_Year; - -end GNAT.Calendar; |