1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . C A L E N D A R --
9 -- Copyright (C) 1999-2006, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 package body GNAT.Calendar is
43 function Day_In_Year (Date : Time) return Day_In_Year_Number is
47 Day_Secs : Day_Duration;
50 Split (Date, Year, Month, Day, Day_Secs);
52 return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1;
59 function Day_Of_Week (Date : Time) return Day_Name is
63 Day_Secs : Day_Duration;
66 Split (Date, Year, Month, Day, Day_Secs);
68 return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7);
75 function Hour (Date : Time) return Hour_Number is
80 Minute : Minute_Number;
81 Second : Second_Number;
82 Sub_Second : Second_Duration;
85 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
93 -- Julian_Day is used to by Day_Of_Week and Day_In_Year. Note that this
94 -- implementation is not expensive.
99 Day : Day_Number) return Integer
101 Internal_Year : Integer;
102 Internal_Month : Integer;
103 Internal_Day : Integer;
104 Julian_Date : Integer;
109 Internal_Year := Integer (Year);
110 Internal_Month := Integer (Month);
111 Internal_Day := Integer (Day);
113 if Internal_Month > 2 then
114 Internal_Month := Internal_Month - 3;
116 Internal_Month := Internal_Month + 9;
117 Internal_Year := Internal_Year - 1;
120 C := Internal_Year / 100;
121 Ya := Internal_Year - (100 * C);
123 Julian_Date := (146_097 * C) / 4 +
125 (153 * Internal_Month + 2) / 5 +
126 Internal_Day + 1_721_119;
135 function Minute (Date : Time) return Minute_Number is
137 Month : Month_Number;
140 Minute : Minute_Number;
141 Second : Second_Number;
142 Sub_Second : Second_Duration;
145 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
153 function Second (Date : Time) return Second_Number is
155 Month : Month_Number;
158 Minute : Minute_Number;
159 Second : Second_Number;
160 Sub_Second : Second_Duration;
163 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
173 Year : out Year_Number;
174 Month : out Month_Number;
175 Day : out Day_Number;
176 Hour : out Hour_Number;
177 Minute : out Minute_Number;
178 Second : out Second_Number;
179 Sub_Second : out Second_Duration)
181 Day_Secs : Day_Duration;
185 Split (Date, Year, Month, Day, Day_Secs);
187 if Day_Secs = 0.0 then
190 Secs := Natural (Day_Secs - 0.5);
193 Sub_Second := Second_Duration (Day_Secs - Day_Duration (Secs));
194 Hour := Hour_Number (Secs / 3_600);
195 Secs := Secs mod 3_600;
196 Minute := Minute_Number (Secs / 60);
197 Second := Second_Number (Secs mod 60);
204 function Sub_Second (Date : Time) return Second_Duration is
206 Month : Month_Number;
209 Minute : Minute_Number;
210 Second : Second_Number;
211 Sub_Second : Second_Duration;
214 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
224 Month : Month_Number;
227 Minute : Minute_Number;
228 Second : Second_Number;
229 Sub_Second : Second_Duration := 0.0) return Time
231 Day_Secs : constant Day_Duration :=
232 Day_Duration (Hour * 3_600) +
233 Day_Duration (Minute * 60) +
234 Day_Duration (Second) +
237 return Time_Of (Year, Month, Day, Day_Secs);
244 function To_Duration (T : not null access timeval) return Duration is
246 procedure timeval_to_duration
247 (T : not null access timeval;
248 sec : not null access C.long;
249 usec : not null access C.long);
250 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
252 Micro : constant := 10**6;
253 sec : aliased C.long;
254 usec : aliased C.long;
257 timeval_to_duration (T, sec'Access, usec'Access);
258 return Duration (sec) + Duration (usec) / Micro;
265 function To_Timeval (D : Duration) return timeval is
267 procedure duration_to_timeval
270 T : not null access timeval);
271 pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
273 Micro : constant := 10**6;
274 Result : aliased timeval;
283 sec := C.long (D - 0.5);
284 usec := C.long ((D - Duration (sec)) * Micro - 0.5);
287 duration_to_timeval (sec, usec, Result'Access);
296 function Week_In_Year (Date : Time) return Week_In_Year_Number is
298 Month : Month_Number;
301 Minute : Minute_Number;
302 Second : Second_Number;
303 Sub_Second : Second_Duration;
307 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
309 -- Day offset number for the first week of the year
311 Offset := Julian_Day (Year, 1, 1) mod 7;
313 return 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;