| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUN-TIME COMPONENTS -- |
| -- -- |
| -- G N A T . C A L E N D A R -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1999-2001 Ada Core Technologies, 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 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; |
| Dsecs : Day_Duration; |
| |
| begin |
| Split (Date, Year, Month, Day, Dsecs); |
| |
| 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; |
| Dsecs : Day_Duration; |
| |
| begin |
| Split (Date, Year, Month, Day, Dsecs); |
| |
| 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; |
| |
| 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; |
| |
| 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; |
| |
| 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 |
| Dsecs : Day_Duration; |
| Secs : Natural; |
| |
| begin |
| Split (Date, Year, Month, Day, Dsecs); |
| |
| if Dsecs = 0.0 then |
| Secs := 0; |
| else |
| Secs := Natural (Dsecs - 0.5); |
| end if; |
| |
| Sub_Second := Second_Duration (Dsecs - 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; |
| |
| ---------------- |
| -- 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; |
| |
| 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 |
| Dsecs : constant Day_Duration := |
| Day_Duration (Hour * 3600 + Minute * 60 + Second) + |
| Sub_Second; |
| begin |
| return Time_Of (Year, Month, Day, Dsecs); |
| end Time_Of; |
| |
| ----------------- |
| -- To_Duration -- |
| ----------------- |
| |
| function To_Duration (T : access timeval) return Duration is |
| |
| procedure timeval_to_duration |
| (T : access timeval; |
| sec : access C.long; |
| usec : 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, Usec : C.long; T : 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 : Ada.Calendar.Time) |
| return Week_In_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; |
| Offset : Natural; |
| |
| begin |
| Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); |
| |
| -- Day offset number for the first week of the year. |
| |
| Offset := Julian_Day (Year, 1, 1) mod 7; |
| |
| return 1 + ((Day_In_Year (Date) - 1) + Offset) / 7; |
| end Week_In_Year; |
| |
| end GNAT.Calendar; |
