1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . C A L E N D A R --
10 -- Copyright (C) 1999-2001 Ada Core Technologies, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 package body GNAT.Calendar is
44 function Day_In_Year (Date : Time) return Day_In_Year_Number is
51 Split (Date, Year, Month, Day, Dsecs);
53 return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1;
60 function Day_Of_Week (Date : Time) return Day_Name is
67 Split (Date, Year, Month, Day, Dsecs);
69 return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7);
76 function Hour (Date : Time) return Hour_Number is
81 Minute : Minute_Number;
82 Second : Second_Number;
83 Sub_Second : Second_Duration;
86 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
94 -- Julian_Day is used to by Day_Of_Week and Day_In_Year. Note
95 -- that this implementation is not expensive.
103 Internal_Year : Integer;
104 Internal_Month : Integer;
105 Internal_Day : Integer;
106 Julian_Date : Integer;
111 Internal_Year := Integer (Year);
112 Internal_Month := Integer (Month);
113 Internal_Day := Integer (Day);
115 if Internal_Month > 2 then
116 Internal_Month := Internal_Month - 3;
118 Internal_Month := Internal_Month + 9;
119 Internal_Year := Internal_Year - 1;
122 C := Internal_Year / 100;
123 Ya := Internal_Year - (100 * C);
125 Julian_Date := (146_097 * C) / 4 +
127 (153 * Internal_Month + 2) / 5 +
128 Internal_Day + 1_721_119;
137 function Minute (Date : Time) return Minute_Number is
139 Month : Month_Number;
142 Minute : Minute_Number;
143 Second : Second_Number;
144 Sub_Second : Second_Duration;
147 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
155 function Second (Date : Time) return Second_Number is
157 Month : Month_Number;
160 Minute : Minute_Number;
161 Second : Second_Number;
162 Sub_Second : Second_Duration;
165 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
175 Year : out Year_Number;
176 Month : out Month_Number;
177 Day : out Day_Number;
178 Hour : out Hour_Number;
179 Minute : out Minute_Number;
180 Second : out Second_Number;
181 Sub_Second : out Second_Duration)
183 Dsecs : Day_Duration;
187 Split (Date, Year, Month, Day, Dsecs);
192 Secs := Natural (Dsecs - 0.5);
195 Sub_Second := Second_Duration (Dsecs - Day_Duration (Secs));
196 Hour := Hour_Number (Secs / 3600);
197 Secs := Secs mod 3600;
198 Minute := Minute_Number (Secs / 60);
199 Second := Second_Number (Secs mod 60);
206 function Sub_Second (Date : Time) return Second_Duration is
208 Month : Month_Number;
211 Minute : Minute_Number;
212 Second : Second_Number;
213 Sub_Second : Second_Duration;
216 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
226 Month : Month_Number;
229 Minute : Minute_Number;
230 Second : Second_Number;
231 Sub_Second : Second_Duration := 0.0)
234 Dsecs : constant Day_Duration :=
235 Day_Duration (Hour * 3600 + Minute * 60 + Second) +
238 return Time_Of (Year, Month, Day, Dsecs);
245 function To_Duration (T : access timeval) return Duration is
247 procedure timeval_to_duration
250 usec : access C.long);
251 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
253 Micro : constant := 10**6;
254 sec : aliased C.long;
255 usec : aliased C.long;
259 timeval_to_duration (T, sec'Access, usec'Access);
260 return Duration (sec) + Duration (usec) / Micro;
267 function To_Timeval (D : Duration) return timeval is
269 procedure duration_to_timeval (Sec, Usec : C.long; T : access timeval);
270 pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
272 Micro : constant := 10**6;
273 Result : aliased timeval;
282 sec := C.long (D - 0.5);
283 usec := C.long ((D - Duration (sec)) * Micro - 0.5);
286 duration_to_timeval (sec, usec, Result'Access);
295 function Week_In_Year
296 (Date : Ada.Calendar.Time)
297 return Week_In_Year_Number
300 Month : Month_Number;
303 Minute : Minute_Number;
304 Second : Second_Number;
305 Sub_Second : Second_Duration;
309 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
311 -- Day offset number for the first week of the year.
313 Offset := Julian_Day (Year, 1, 1) mod 7;
315 return 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;