1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . C A L E N D A R --
9 -- Copyright (C) 1992-2007, Free Software Foundation, 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, 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 with Ada.Unchecked_Conversion;
36 with System.OS_Primitives;
39 package body Ada.Calendar is
41 --------------------------
42 -- Implementation Notes --
43 --------------------------
45 -- In complex algorithms, some variables of type Ada.Calendar.Time carry
46 -- suffix _S or _N to denote units of seconds or nanoseconds.
48 -- Because time is measured in different units and from different origins
49 -- on various targets, a system independent model is incorporated into
50 -- Ada.Calendar. The idea behind the design is to encapsulate all target
51 -- dependent machinery in a single package, thus providing a uniform
52 -- interface to all existing and any potential children.
54 -- package Ada.Calendar
55 -- procedure Split (5 parameters) -------+
56 -- | Call from local routine
58 -- package Formatting_Operations |
59 -- procedure Split (11 parameters) <--+
60 -- end Formatting_Operations |
63 -- package Ada.Calendar.Formatting | Call from child routine
64 -- procedure Split (9 or 10 parameters) -+
65 -- end Ada.Calendar.Formatting
67 -- The behaviour of the interfacing routines is controlled via various
68 -- flags. All new Ada 2005 types from children of Ada.Calendar are
69 -- emulated by a similar type. For instance, type Day_Number is replaced
70 -- by Integer in various routines. One ramification of this model is that
71 -- the caller site must perform validity checks on returned results.
72 -- The end result of this model is the lack of target specific files per
73 -- child of Ada.Calendar (a-calfor, a-calfor-vms, a-calfor-vxwors, etc).
75 -----------------------
76 -- Local Subprograms --
77 -----------------------
79 procedure Check_Within_Time_Bounds (T : Time_Rep);
80 -- Ensure that a time representation value falls withing the bounds of Ada
81 -- time. Leap seconds support is taken into account.
83 procedure Cumulative_Leap_Seconds
84 (Start_Date : Time_Rep;
86 Elapsed_Leaps : out Natural;
87 Next_Leap : out Time_Rep);
88 -- Elapsed_Leaps is the sum of the leap seconds that have occured on or
89 -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
90 -- represents the next leap second occurence on or after End_Date. If
91 -- there are no leaps seconds after End_Date, End_Of_Time is returned.
92 -- End_Of_Time can be used as End_Date to count all the leap seconds that
93 -- have occured on or after Start_Date.
95 -- Note: Any sub seconds of Start_Date and End_Date are discarded before
96 -- the calculations are done. For instance: if 113 seconds is a leap
97 -- second (it isn't) and 113.5 is input as an End_Date, the leap second
98 -- at 113 will not be counted in Leaps_Between, but it will be returned
99 -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
100 -- a leap second, the comparison should be:
102 -- End_Date >= Next_Leap_Sec;
104 -- After_Last_Leap is designed so that this comparison works without
105 -- having to first check if Next_Leap_Sec is a valid leap second.
107 function Duration_To_Time_Rep is
108 new Ada.Unchecked_Conversion (Duration, Time_Rep);
109 -- Convert a duration value into a time representation value
111 function Time_Rep_To_Duration is
112 new Ada.Unchecked_Conversion (Time_Rep, Duration);
113 -- Convert a time representation value into a duration value
119 -- An integer time duration. The type is used whenever a positive elapsed
120 -- duration is needed, for instance when splitting a time value. Here is
121 -- how Time_Rep and Time_Dur are related:
123 -- 'First Ada_Low Ada_High 'Last
124 -- Time_Rep: +-------+------------------------+---------+
125 -- Time_Dur: +------------------------+---------+
128 type Time_Dur is range 0 .. 2 ** 63 - 1;
130 --------------------------
131 -- Leap seconds control --
132 --------------------------
135 pragma Import (C, Flag, "__gl_leap_seconds_support");
136 -- This imported value is used to determine whether the compilation had
137 -- binder flag "-y" present which enables leap seconds. A value of zero
138 -- signifies no leap seconds support while a value of one enables the
141 Leap_Support : constant Boolean := Flag = 1;
142 -- The above flag controls the usage of leap seconds in all Ada.Calendar
145 Leap_Seconds_Count : constant Natural := 23;
147 ---------------------
148 -- Local Constants --
149 ---------------------
151 Ada_Min_Year : constant Year_Number := Year_Number'First;
152 Secs_In_Four_Years : constant := (3 * 365 + 366) * Secs_In_Day;
153 Secs_In_Non_Leap_Year : constant := 365 * Secs_In_Day;
155 -- Lower and upper bound of Ada time. The zero (0) value of type Time is
156 -- positioned at year 2150. Note that the lower and upper bound account
157 -- for the non-leap centenial years.
159 Ada_Low : constant Time_Rep := -(61 * 366 + 188 * 365) * Nanos_In_Day;
160 Ada_High : constant Time_Rep := (60 * 366 + 190 * 365) * Nanos_In_Day;
162 -- Even though the upper bound of time is 2399-12-31 23:59:59.999999999
163 -- UTC, it must be increased to include all leap seconds.
165 Ada_High_And_Leaps : constant Time_Rep :=
166 Ada_High + Time_Rep (Leap_Seconds_Count) * Nano;
168 -- Two constants used in the calculations of elapsed leap seconds.
169 -- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time
170 -- is earlier than Ada_Low in time zone +28.
172 End_Of_Time : constant Time_Rep :=
173 Ada_High + Time_Rep (3) * Nanos_In_Day;
174 Start_Of_Time : constant Time_Rep :=
175 Ada_Low - Time_Rep (3) * Nanos_In_Day;
177 -- The Unix lower time bound expressed as nanoseconds since the
178 -- start of Ada time in UTC.
180 Unix_Min : constant Time_Rep :=
181 Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
183 Cumulative_Days_Before_Month :
184 constant array (Month_Number) of Natural :=
185 (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
187 -- The following table contains the hard time values of all existing leap
188 -- seconds. The values are produced by the utility program xleaps.adb.
190 Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of Time_Rep :=
191 (-5601484800000000000,
192 -5585587199000000000,
193 -5554051198000000000,
194 -5522515197000000000,
195 -5490979196000000000,
196 -5459356795000000000,
197 -5427820794000000000,
198 -5396284793000000000,
199 -5364748792000000000,
200 -5317487991000000000,
201 -5285951990000000000,
202 -5254415989000000000,
203 -5191257588000000000,
204 -5112287987000000000,
205 -5049129586000000000,
206 -5017593585000000000,
207 -4970332784000000000,
208 -4938796783000000000,
209 -4907260782000000000,
210 -4859827181000000000,
211 -4812566380000000000,
212 -4765132779000000000,
213 -4544207978000000000);
219 function "+" (Left : Time; Right : Duration) return Time is
220 pragma Unsuppress (Overflow_Check);
221 Left_N : constant Time_Rep := Time_Rep (Left);
223 return Time (Left_N + Duration_To_Time_Rep (Right));
225 when Constraint_Error =>
229 function "+" (Left : Duration; Right : Time) return Time is
238 function "-" (Left : Time; Right : Duration) return Time is
239 pragma Unsuppress (Overflow_Check);
240 Left_N : constant Time_Rep := Time_Rep (Left);
242 return Time (Left_N - Duration_To_Time_Rep (Right));
244 when Constraint_Error =>
248 function "-" (Left : Time; Right : Time) return Duration is
249 pragma Unsuppress (Overflow_Check);
251 -- The bounds of type Duration expressed as time representations
253 Dur_Low : constant Time_Rep := Duration_To_Time_Rep (Duration'First);
254 Dur_High : constant Time_Rep := Duration_To_Time_Rep (Duration'Last);
259 Res_N := Time_Rep (Left) - Time_Rep (Right);
261 -- Due to the extended range of Ada time, "-" is capable of producing
262 -- results which may exceed the range of Duration. In order to prevent
263 -- the generation of bogus values by the Unchecked_Conversion, we apply
264 -- the following check.
267 or else Res_N > Dur_High
272 return Time_Rep_To_Duration (Res_N);
274 when Constraint_Error =>
282 function "<" (Left, Right : Time) return Boolean is
284 return Time_Rep (Left) < Time_Rep (Right);
291 function "<=" (Left, Right : Time) return Boolean is
293 return Time_Rep (Left) <= Time_Rep (Right);
300 function ">" (Left, Right : Time) return Boolean is
302 return Time_Rep (Left) > Time_Rep (Right);
309 function ">=" (Left, Right : Time) return Boolean is
311 return Time_Rep (Left) >= Time_Rep (Right);
314 ------------------------------
315 -- Check_Within_Time_Bounds --
316 ------------------------------
318 procedure Check_Within_Time_Bounds (T : Time_Rep) is
321 if T < Ada_Low or else T > Ada_High_And_Leaps then
325 if T < Ada_Low or else T > Ada_High then
329 end Check_Within_Time_Bounds;
335 function Clock return Time is
336 Elapsed_Leaps : Natural;
337 Next_Leap_N : Time_Rep;
339 -- The system clock returns the time in UTC since the Unix Epoch of
340 -- 1970-01-01 00:00:00.0. We perform an origin shift to the Ada Epoch
341 -- by adding the number of nanoseconds between the two origins.
344 Duration_To_Time_Rep (System.OS_Primitives.Clock) +
348 -- If the target supports leap seconds, determine the number of leap
349 -- seconds elapsed until this moment.
352 Cumulative_Leap_Seconds
353 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
355 -- The system clock may fall exactly on a leap second
357 if Res_N >= Next_Leap_N then
358 Elapsed_Leaps := Elapsed_Leaps + 1;
361 -- The target does not support leap seconds
367 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano;
372 -----------------------------
373 -- Cumulative_Leap_Seconds --
374 -----------------------------
376 procedure Cumulative_Leap_Seconds
377 (Start_Date : Time_Rep;
379 Elapsed_Leaps : out Natural;
380 Next_Leap : out Time_Rep)
382 End_Index : Positive;
383 End_T : Time_Rep := End_Date;
384 Start_Index : Positive;
385 Start_T : Time_Rep := Start_Date;
388 -- Both input dates must be normalized to UTC
390 pragma Assert (Leap_Support and then End_Date >= Start_Date);
392 Next_Leap := End_Of_Time;
394 -- Make sure that the end date does not excede the upper bound
397 if End_Date > Ada_High then
401 -- Remove the sub seconds from both dates
403 Start_T := Start_T - (Start_T mod Nano);
404 End_T := End_T - (End_T mod Nano);
406 -- Some trivial cases:
407 -- Leap 1 . . . Leap N
408 -- ---+========+------+############+-------+========+-----
409 -- Start_T End_T Start_T End_T
411 if End_T < Leap_Second_Times (1) then
413 Next_Leap := Leap_Second_Times (1);
416 elsif Start_T > Leap_Second_Times (Leap_Seconds_Count) then
418 Next_Leap := End_Of_Time;
422 -- Perform the calculations only if the start date is within the leap
423 -- second occurences table.
425 if Start_T <= Leap_Second_Times (Leap_Seconds_Count) then
428 -- +----+----+-- . . . --+-------+---+
429 -- | T1 | T2 | | N - 1 | N |
430 -- +----+----+-- . . . --+-------+---+
432 -- | Start_Index | End_Index
433 -- +-------------------+
436 -- The idea behind the algorithm is to iterate and find two
437 -- closest dates which are after Start_T and End_T. Their
438 -- corresponding index difference denotes the number of leap
443 exit when Leap_Second_Times (Start_Index) >= Start_T;
444 Start_Index := Start_Index + 1;
447 End_Index := Start_Index;
449 exit when End_Index > Leap_Seconds_Count
450 or else Leap_Second_Times (End_Index) >= End_T;
451 End_Index := End_Index + 1;
454 if End_Index <= Leap_Seconds_Count then
455 Next_Leap := Leap_Second_Times (End_Index);
458 Elapsed_Leaps := End_Index - Start_Index;
463 end Cumulative_Leap_Seconds;
469 function Day (Date : Time) return Day_Number is
474 pragma Unreferenced (Y, M, S);
476 Split (Date, Y, M, D, S);
484 function Is_Leap (Year : Year_Number) return Boolean is
486 -- Leap centenial years
488 if Year mod 400 = 0 then
491 -- Non-leap centenial years
493 elsif Year mod 100 = 0 then
499 return Year mod 4 = 0;
507 function Month (Date : Time) return Month_Number is
512 pragma Unreferenced (Y, D, S);
514 Split (Date, Y, M, D, S);
522 function Seconds (Date : Time) return Day_Duration is
527 pragma Unreferenced (Y, M, D);
529 Split (Date, Y, M, D, S);
539 Year : out Year_Number;
540 Month : out Month_Number;
541 Day : out Day_Number;
542 Seconds : out Day_Duration)
550 pragma Unreferenced (H, M, Se, Ss, Le);
553 -- Even though the input time zone is UTC (0), the flag Is_Ada_05 will
554 -- ensure that Split picks up the local time zone.
556 Formatting_Operations.Split
573 or else not Month'Valid
574 or else not Day'Valid
575 or else not Seconds'Valid
587 Month : Month_Number;
589 Seconds : Day_Duration := 0.0) return Time
591 -- The values in the following constants are irrelevant, they are just
592 -- placeholders; the choice of constructing a Day_Duration value is
593 -- controlled by the Use_Day_Secs flag.
595 H : constant Integer := 1;
596 M : constant Integer := 1;
597 Se : constant Integer := 1;
598 Ss : constant Duration := 0.1;
604 or else not Month'Valid
605 or else not Day'Valid
606 or else not Seconds'Valid
611 -- Even though the input time zone is UTC (0), the flag Is_Ada_05 will
612 -- ensure that Split picks up the local time zone.
615 Formatting_Operations.Time_Of
625 Use_Day_Secs => True,
634 function Year (Date : Time) return Year_Number is
639 pragma Unreferenced (M, D, S);
641 Split (Date, Y, M, D, S);
645 -- The following packages assume that Time is a signed 64 bit integer
646 -- type, the units are nanoseconds and the origin is the start of Ada
647 -- time (1901-01-01 00:00:00.0 UTC).
649 ---------------------------
650 -- Arithmetic_Operations --
651 ---------------------------
653 package body Arithmetic_Operations is
659 function Add (Date : Time; Days : Long_Integer) return Time is
660 pragma Unsuppress (Overflow_Check);
661 Date_N : constant Time_Rep := Time_Rep (Date);
663 return Time (Date_N + Time_Rep (Days) * Nanos_In_Day);
665 when Constraint_Error =>
676 Days : out Long_Integer;
677 Seconds : out Duration;
678 Leap_Seconds : out Integer)
682 Elapsed_Leaps : Natural;
684 Negate : Boolean := False;
685 Next_Leap_N : Time_Rep;
687 Sub_Secs_Diff : Time_Rep;
690 -- Both input time values are assumed to be in UTC
692 if Left >= Right then
693 Later := Time_Rep (Left);
694 Earlier := Time_Rep (Right);
696 Later := Time_Rep (Right);
697 Earlier := Time_Rep (Left);
701 -- If the target supports leap seconds, process them
704 Cumulative_Leap_Seconds
705 (Earlier, Later, Elapsed_Leaps, Next_Leap_N);
707 if Later >= Next_Leap_N then
708 Elapsed_Leaps := Elapsed_Leaps + 1;
711 -- The target does not support leap seconds
717 -- Sub seconds processing. We add the resulting difference to one
718 -- of the input dates in order to account for any potential rounding
719 -- of the difference in the next step.
721 Sub_Secs_Diff := Later mod Nano - Earlier mod Nano;
722 Earlier := Earlier + Sub_Secs_Diff;
723 Sub_Secs := Duration (Sub_Secs_Diff) / Nano_F;
725 -- Difference processing. This operation should be able to calculate
726 -- the difference between opposite values which are close to the end
727 -- and start of Ada time. To accomodate the large range, we convert
728 -- to seconds. This action may potentially round the two values and
729 -- either add or drop a second. We compensate for this issue in the
733 Time_Dur (Later / Nano - Earlier / Nano) - Time_Dur (Elapsed_Leaps);
735 Days := Long_Integer (Res_Dur / Secs_In_Day);
736 Seconds := Duration (Res_Dur mod Secs_In_Day) + Sub_Secs;
737 Leap_Seconds := Integer (Elapsed_Leaps);
743 if Leap_Seconds /= 0 then
744 Leap_Seconds := -Leap_Seconds;
753 function Subtract (Date : Time; Days : Long_Integer) return Time is
754 pragma Unsuppress (Overflow_Check);
755 Date_N : constant Time_Rep := Time_Rep (Date);
757 return Time (Date_N - Time_Rep (Days) * Nanos_In_Day);
759 when Constraint_Error =>
762 end Arithmetic_Operations;
764 ----------------------
765 -- Delay_Operations --
766 ----------------------
768 package body Delays_Operations is
774 function To_Duration (Date : Time) return Duration is
775 Elapsed_Leaps : Natural;
776 Next_Leap_N : Time_Rep;
780 Res_N := Time_Rep (Date);
782 -- If the target supports leap seconds, remove any leap seconds
783 -- elapsed upto the input date.
786 Cumulative_Leap_Seconds
787 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
789 -- The input time value may fall on a leap second occurence
791 if Res_N >= Next_Leap_N then
792 Elapsed_Leaps := Elapsed_Leaps + 1;
795 -- The target does not support leap seconds
801 Res_N := Res_N - Time_Rep (Elapsed_Leaps) * Nano;
803 -- Perform a shift in origins, note that enforcing type Time on
804 -- both operands will invoke Ada.Calendar."-".
806 return Time (Res_N) - Time (Unix_Min);
808 end Delays_Operations;
810 ---------------------------
811 -- Formatting_Operations --
812 ---------------------------
814 package body Formatting_Operations is
820 function Day_Of_Week (Date : Time) return Integer is
831 pragma Unreferenced (Ds, H, Mi, Se, Su, Le);
833 Day_Count : Long_Integer;
838 Formatting_Operations.Split
852 -- Build a time value in the middle of the same day
856 (Formatting_Operations.Time_Of
866 Use_Day_Secs => False,
870 -- Determine the elapsed seconds since the start of Ada time
872 Res_Dur := Time_Dur (Res_N / Nano - Ada_Low / Nano);
874 -- Count the number of days since the start of Ada time. 1901-1-1
875 -- GMT was a Tuesday.
877 Day_Count := Long_Integer (Res_Dur / Secs_In_Day) + 1;
879 return Integer (Day_Count mod 7);
888 Year : out Year_Number;
889 Month : out Month_Number;
890 Day : out Day_Number;
891 Day_Secs : out Day_Duration;
893 Minute : out Integer;
894 Second : out Integer;
895 Sub_Sec : out Duration;
896 Leap_Sec : out Boolean;
898 Time_Zone : Long_Integer)
900 -- The following constants represent the number of nanoseconds
901 -- elapsed since the start of Ada time to and including the non
902 -- leap centenial years.
904 Year_2101 : constant Time_Rep := Ada_Low +
905 Time_Rep (49 * 366 + 151 * 365) * Nanos_In_Day;
906 Year_2201 : constant Time_Rep := Ada_Low +
907 Time_Rep (73 * 366 + 227 * 365) * Nanos_In_Day;
908 Year_2301 : constant Time_Rep := Ada_Low +
909 Time_Rep (97 * 366 + 303 * 365) * Nanos_In_Day;
913 Day_Seconds : Natural;
914 Elapsed_Leaps : Natural;
915 Four_Year_Segs : Natural;
916 Hour_Seconds : Natural;
917 Is_Leap_Year : Boolean;
918 Next_Leap_N : Time_Rep;
920 Sub_Sec_N : Time_Rep;
924 Date_N := Time_Rep (Date);
926 -- Step 1: Leap seconds processing in UTC
929 Cumulative_Leap_Seconds
930 (Start_Of_Time, Date_N, Elapsed_Leaps, Next_Leap_N);
932 Leap_Sec := Date_N >= Next_Leap_N;
935 Elapsed_Leaps := Elapsed_Leaps + 1;
938 -- The target does not support leap seconds
945 Date_N := Date_N - Time_Rep (Elapsed_Leaps) * Nano;
947 -- Step 2: Time zone processing. This action converts the input date
948 -- from GMT to the requested time zone.
951 if Time_Zone /= 0 then
952 Date_N := Date_N + Time_Rep (Time_Zone) * 60 * Nano;
959 Off : constant Long_Integer :=
960 Time_Zones_Operations.UTC_Time_Offset (Time (Date_N));
962 Date_N := Date_N + Time_Rep (Off) * Nano;
966 -- Step 3: Non-leap centenial year adjustment in local time zone
968 -- In order for all divisions to work properly and to avoid more
969 -- complicated arithmetic, we add fake Febriary 29s to dates which
970 -- occur after a non-leap centenial year.
972 if Date_N >= Year_2301 then
973 Date_N := Date_N + Time_Rep (3) * Nanos_In_Day;
975 elsif Date_N >= Year_2201 then
976 Date_N := Date_N + Time_Rep (2) * Nanos_In_Day;
978 elsif Date_N >= Year_2101 then
979 Date_N := Date_N + Time_Rep (1) * Nanos_In_Day;
982 -- Step 4: Sub second processing in local time zone
984 Sub_Sec_N := Date_N mod Nano;
985 Sub_Sec := Duration (Sub_Sec_N) / Nano_F;
986 Date_N := Date_N - Sub_Sec_N;
988 -- Convert Date_N into a time duration value, changing the units
991 Date_Dur := Time_Dur (Date_N / Nano - Ada_Low / Nano);
993 -- Step 5: Year processing in local time zone. Determine the number
994 -- of four year segments since the start of Ada time and the input
997 Four_Year_Segs := Natural (Date_Dur / Secs_In_Four_Years);
999 if Four_Year_Segs > 0 then
1000 Date_Dur := Date_Dur - Time_Dur (Four_Year_Segs) *
1004 -- Calculate the remaining non-leap years
1006 Rem_Years := Natural (Date_Dur / Secs_In_Non_Leap_Year);
1008 if Rem_Years > 3 then
1012 Date_Dur := Date_Dur - Time_Dur (Rem_Years) * Secs_In_Non_Leap_Year;
1014 Year := Ada_Min_Year + Natural (4 * Four_Year_Segs + Rem_Years);
1015 Is_Leap_Year := Is_Leap (Year);
1017 -- Step 6: Month and day processing in local time zone
1019 Year_Day := Natural (Date_Dur / Secs_In_Day) + 1;
1023 -- Processing for months after January
1025 if Year_Day > 31 then
1027 Year_Day := Year_Day - 31;
1029 -- Processing for a new month or a leap February
1032 and then (not Is_Leap_Year or else Year_Day > 29)
1035 Year_Day := Year_Day - 28;
1037 if Is_Leap_Year then
1038 Year_Day := Year_Day - 1;
1043 while Year_Day > Days_In_Month (Month) loop
1044 Year_Day := Year_Day - Days_In_Month (Month);
1050 -- Step 7: Hour, minute, second and sub second processing in local
1053 Day := Day_Number (Year_Day);
1054 Day_Seconds := Integer (Date_Dur mod Secs_In_Day);
1055 Day_Secs := Duration (Day_Seconds) + Sub_Sec;
1056 Hour := Day_Seconds / 3_600;
1057 Hour_Seconds := Day_Seconds mod 3_600;
1058 Minute := Hour_Seconds / 60;
1059 Second := Hour_Seconds mod 60;
1067 (Year : Year_Number;
1068 Month : Month_Number;
1070 Day_Secs : Day_Duration;
1076 Use_Day_Secs : Boolean;
1077 Is_Ada_05 : Boolean;
1078 Time_Zone : Long_Integer) return Time
1081 Elapsed_Leaps : Natural;
1082 Next_Leap_N : Time_Rep;
1084 Rounded_Res_N : Time_Rep;
1087 -- Step 1: Check whether the day, month and year form a valid date
1089 if Day > Days_In_Month (Month)
1090 and then (Day /= 29 or else Month /= 2 or else not Is_Leap (Year))
1095 -- Start accumulating nanoseconds from the low bound of Ada time
1099 -- Step 2: Year processing and centenial year adjustment. Determine
1100 -- the number of four year segments since the start of Ada time and
1103 Count := (Year - Year_Number'First) / 4;
1104 Res_N := Res_N + Time_Rep (Count) * Secs_In_Four_Years * Nano;
1106 -- Note that non-leap centenial years are automatically considered
1107 -- leap in the operation above. An adjustment of several days is
1108 -- required to compensate for this.
1111 Res_N := Res_N - Time_Rep (3) * Nanos_In_Day;
1113 elsif Year > 2200 then
1114 Res_N := Res_N - Time_Rep (2) * Nanos_In_Day;
1116 elsif Year > 2100 then
1117 Res_N := Res_N - Time_Rep (1) * Nanos_In_Day;
1120 -- Add the remaining non-leap years
1122 Count := (Year - Year_Number'First) mod 4;
1123 Res_N := Res_N + Time_Rep (Count) * Secs_In_Non_Leap_Year * Nano;
1125 -- Step 3: Day of month processing. Determine the number of days
1126 -- since the start of the current year. Do not add the current
1127 -- day since it has not elapsed yet.
1129 Count := Cumulative_Days_Before_Month (Month) + Day - 1;
1131 -- The input year is leap and we have passed February
1139 Res_N := Res_N + Time_Rep (Count) * Nanos_In_Day;
1141 -- Step 4: Hour, minute, second and sub second processing
1143 if Use_Day_Secs then
1144 Res_N := Res_N + Duration_To_Time_Rep (Day_Secs);
1148 Time_Rep (Hour * 3_600 + Minute * 60 + Second) * Nano;
1150 if Sub_Sec = 1.0 then
1151 Res_N := Res_N + Time_Rep (1) * Nano;
1153 Res_N := Res_N + Duration_To_Time_Rep (Sub_Sec);
1157 -- At this point, the generated time value should be withing the
1158 -- bounds of Ada time.
1160 Check_Within_Time_Bounds (Res_N);
1162 -- Step 4: Time zone processing. At this point we have built an
1163 -- arbitrary time value which is not related to any time zone.
1164 -- For simplicity, the time value is normalized to GMT, producing
1165 -- a uniform representation which can be treated by arithmetic
1166 -- operations for instance without any additional corrections.
1169 if Time_Zone /= 0 then
1170 Res_N := Res_N - Time_Rep (Time_Zone) * 60 * Nano;
1177 Current_Off : constant Long_Integer :=
1178 Time_Zones_Operations.UTC_Time_Offset
1180 Current_Res_N : constant Time_Rep :=
1181 Res_N - Time_Rep (Current_Off) * Nano;
1182 Off : constant Long_Integer :=
1183 Time_Zones_Operations.UTC_Time_Offset
1184 (Time (Current_Res_N));
1186 Res_N := Res_N - Time_Rep (Off) * Nano;
1190 -- Step 5: Leap seconds processing in GMT
1192 if Leap_Support then
1193 Cumulative_Leap_Seconds
1194 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
1196 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano;
1198 -- An Ada 2005 caller requesting an explicit leap second or an
1199 -- Ada 95 caller accounting for an invisible leap second.
1202 or else Res_N >= Next_Leap_N
1204 Res_N := Res_N + Time_Rep (1) * Nano;
1207 -- Leap second validity check
1209 Rounded_Res_N := Res_N - (Res_N mod Nano);
1213 and then Rounded_Res_N /= Next_Leap_N
1219 return Time (Res_N);
1221 end Formatting_Operations;
1223 ---------------------------
1224 -- Time_Zones_Operations --
1225 ---------------------------
1227 package body Time_Zones_Operations is
1229 -- The Unix time bounds in nanoseconds: 1970/1/1 .. 2037/1/1
1231 Unix_Min : constant Time_Rep := Ada_Low +
1232 Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
1234 Unix_Max : constant Time_Rep := Ada_Low +
1235 Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day +
1236 Time_Rep (Leap_Seconds_Count) * Nano;
1238 -- The following constants denote February 28 during non-leap
1239 -- centenial years, the units are nanoseconds.
1241 T_2100_2_28 : constant Time_Rep := Ada_Low +
1242 (Time_Rep (49 * 366 + 150 * 365 + 59) * Secs_In_Day +
1243 Time_Rep (Leap_Seconds_Count)) * Nano;
1245 T_2200_2_28 : constant Time_Rep := Ada_Low +
1246 (Time_Rep (73 * 366 + 226 * 365 + 59) * Secs_In_Day +
1247 Time_Rep (Leap_Seconds_Count)) * Nano;
1249 T_2300_2_28 : constant Time_Rep := Ada_Low +
1250 (Time_Rep (97 * 366 + 302 * 365 + 59) * Secs_In_Day +
1251 Time_Rep (Leap_Seconds_Count)) * Nano;
1253 -- 56 years (14 leap years + 42 non leap years) in nanoseconds:
1255 Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day;
1257 -- Base C types. There is no point dragging in Interfaces.C just for
1258 -- these four types.
1260 type char_Pointer is access Character;
1261 subtype int is Integer;
1262 subtype long is Long_Integer;
1263 type long_Pointer is access all long;
1265 -- The Ada equivalent of struct tm and type time_t
1268 tm_sec : int; -- seconds after the minute (0 .. 60)
1269 tm_min : int; -- minutes after the hour (0 .. 59)
1270 tm_hour : int; -- hours since midnight (0 .. 24)
1271 tm_mday : int; -- day of the month (1 .. 31)
1272 tm_mon : int; -- months since January (0 .. 11)
1273 tm_year : int; -- years since 1900
1274 tm_wday : int; -- days since Sunday (0 .. 6)
1275 tm_yday : int; -- days since January 1 (0 .. 365)
1276 tm_isdst : int; -- Daylight Savings Time flag (-1 .. 1)
1277 tm_gmtoff : long; -- offset from UTC in seconds
1278 tm_zone : char_Pointer; -- timezone abbreviation
1281 type tm_Pointer is access all tm;
1283 subtype time_t is long;
1284 type time_t_Pointer is access all time_t;
1286 procedure localtime_tzoff
1287 (C : time_t_Pointer;
1289 off : long_Pointer);
1290 pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
1291 -- This is a lightweight wrapper around the system library function
1292 -- localtime_r. Parameter 'off' captures the UTC offset which is either
1293 -- retrieved from the tm struct or calculated from the 'timezone' extern
1294 -- and the tm_isdst flag in the tm struct.
1296 ---------------------
1297 -- UTC_Time_Offset --
1298 ---------------------
1300 function UTC_Time_Offset (Date : Time) return Long_Integer is
1301 Adj_Cent : Integer := 0;
1303 Offset : aliased long;
1304 Secs_T : aliased time_t;
1305 Secs_TM : aliased tm;
1308 Date_N := Time_Rep (Date);
1310 -- Dates which are 56 years appart fall on the same day, day light
1311 -- saving and so on. Non-leap centenial years violate this rule by
1312 -- one day and as a consequence, special adjustment is needed.
1314 if Date_N > T_2100_2_28 then
1315 if Date_N > T_2200_2_28 then
1316 if Date_N > T_2300_2_28 then
1327 if Adj_Cent > 0 then
1328 Date_N := Date_N - Time_Rep (Adj_Cent) * Nanos_In_Day;
1331 -- Shift the date within bounds of Unix time
1333 while Date_N < Unix_Min loop
1334 Date_N := Date_N + Nanos_In_56_Years;
1337 while Date_N >= Unix_Max loop
1338 Date_N := Date_N - Nanos_In_56_Years;
1341 -- Perform a shift in origins from Ada to Unix
1343 Date_N := Date_N - Unix_Min;
1345 -- Convert the date into seconds
1347 Secs_T := time_t (Date_N / Nano);
1350 (Secs_T'Unchecked_Access,
1351 Secs_TM'Unchecked_Access,
1352 Offset'Unchecked_Access);
1355 end UTC_Time_Offset;
1356 end Time_Zones_Operations;
1358 -- Start of elaboration code for Ada.Calendar
1361 System.OS_Primitives.Initialize;