1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . C A L E N D A R --
9 -- Copyright (C) 1999-2001 Ada Core Technologies, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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
50 Split (Date, Year, Month, Day, Dsecs);
52 return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1;
59 function Day_Of_Week (Date : Time) return Day_Name is
66 Split (Date, Year, Month, Day, Dsecs);
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
94 -- that this implementation is not expensive.
102 Internal_Year : Integer;
103 Internal_Month : Integer;
104 Internal_Day : Integer;
105 Julian_Date : Integer;
110 Internal_Year := Integer (Year);
111 Internal_Month := Integer (Month);
112 Internal_Day := Integer (Day);
114 if Internal_Month > 2 then
115 Internal_Month := Internal_Month - 3;
117 Internal_Month := Internal_Month + 9;
118 Internal_Year := Internal_Year - 1;
121 C := Internal_Year / 100;
122 Ya := Internal_Year - (100 * C);
124 Julian_Date := (146_097 * C) / 4 +
126 (153 * Internal_Month + 2) / 5 +
127 Internal_Day + 1_721_119;
136 function Minute (Date : Time) return Minute_Number is
138 Month : Month_Number;
141 Minute : Minute_Number;
142 Second : Second_Number;
143 Sub_Second : Second_Duration;
146 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
154 function Second (Date : Time) return Second_Number is
156 Month : Month_Number;
159 Minute : Minute_Number;
160 Second : Second_Number;
161 Sub_Second : Second_Duration;
164 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
174 Year : out Year_Number;
175 Month : out Month_Number;
176 Day : out Day_Number;
177 Hour : out Hour_Number;
178 Minute : out Minute_Number;
179 Second : out Second_Number;
180 Sub_Second : out Second_Duration)
182 Dsecs : Day_Duration;
186 Split (Date, Year, Month, Day, Dsecs);
191 Secs := Natural (Dsecs - 0.5);
194 Sub_Second := Second_Duration (Dsecs - Day_Duration (Secs));
195 Hour := Hour_Number (Secs / 3600);
196 Secs := Secs mod 3600;
197 Minute := Minute_Number (Secs / 60);
198 Second := Second_Number (Secs mod 60);
205 function Sub_Second (Date : Time) return Second_Duration is
207 Month : Month_Number;
210 Minute : Minute_Number;
211 Second : Second_Number;
212 Sub_Second : Second_Duration;
215 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
225 Month : Month_Number;
228 Minute : Minute_Number;
229 Second : Second_Number;
230 Sub_Second : Second_Duration := 0.0)
233 Dsecs : constant Day_Duration :=
234 Day_Duration (Hour * 3600 + Minute * 60 + Second) +
237 return Time_Of (Year, Month, Day, Dsecs);
244 function To_Duration (T : access timeval) return Duration is
246 procedure timeval_to_duration
249 usec : 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;
258 timeval_to_duration (T, sec'Access, usec'Access);
259 return Duration (sec) + Duration (usec) / Micro;
266 function To_Timeval (D : Duration) return timeval is
268 procedure duration_to_timeval (Sec, Usec : C.long; T : access timeval);
269 pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
271 Micro : constant := 10**6;
272 Result : aliased timeval;
281 sec := C.long (D - 0.5);
282 usec := C.long ((D - Duration (sec)) * Micro - 0.5);
285 duration_to_timeval (sec, usec, Result'Access);
294 function Week_In_Year
295 (Date : Ada.Calendar.Time)
296 return Week_In_Year_Number
299 Month : Month_Number;
302 Minute : Minute_Number;
303 Second : Second_Number;
304 Sub_Second : Second_Duration;
308 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
310 -- Day offset number for the first week of the year.
312 Offset := Julian_Day (Year, 1, 1) mod 7;
314 return 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;