1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . C A L E N D A R --
9 -- Copyright (C) 1992-2008, 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
;
38 package body Ada
.Calendar
is
40 --------------------------
41 -- Implementation Notes --
42 --------------------------
44 -- In complex algorithms, some variables of type Ada.Calendar.Time carry
45 -- suffix _S or _N to denote units of seconds or nanoseconds.
47 -- Because time is measured in different units and from different origins
48 -- on various targets, a system independent model is incorporated into
49 -- Ada.Calendar. The idea behind the design is to encapsulate all target
50 -- dependent machinery in a single package, thus providing a uniform
51 -- interface to all existing and any potential children.
53 -- package Ada.Calendar
54 -- procedure Split (5 parameters) -------+
55 -- | Call from local routine
57 -- package Formatting_Operations |
58 -- procedure Split (11 parameters) <--+
59 -- end Formatting_Operations |
62 -- package Ada.Calendar.Formatting | Call from child routine
63 -- procedure Split (9 or 10 parameters) -+
64 -- end Ada.Calendar.Formatting
66 -- The behaviour of the interfacing routines is controlled via various
67 -- flags. All new Ada 2005 types from children of Ada.Calendar are
68 -- emulated by a similar type. For instance, type Day_Number is replaced
69 -- by Integer in various routines. One ramification of this model is that
70 -- the caller site must perform validity checks on returned results.
71 -- The end result of this model is the lack of target specific files per
72 -- child of Ada.Calendar (a-calfor, a-calfor-vms, a-calfor-vxwors, etc).
74 -----------------------
75 -- Local Subprograms --
76 -----------------------
78 procedure Check_Within_Time_Bounds
(T
: Time_Rep
);
79 -- Ensure that a time representation value falls withing the bounds of Ada
80 -- time. Leap seconds support is taken into account.
82 procedure Cumulative_Leap_Seconds
83 (Start_Date
: Time_Rep
;
85 Elapsed_Leaps
: out Natural;
86 Next_Leap
: out Time_Rep
);
87 -- Elapsed_Leaps is the sum of the leap seconds that have occurred on or
88 -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
89 -- represents the next leap second occurrence on or after End_Date. If
90 -- there are no leaps seconds after End_Date, End_Of_Time is returned.
91 -- End_Of_Time can be used as End_Date to count all the leap seconds that
92 -- have occurred on or after Start_Date.
94 -- Note: Any sub seconds of Start_Date and End_Date are discarded before
95 -- the calculations are done. For instance: if 113 seconds is a leap
96 -- second (it isn't) and 113.5 is input as an End_Date, the leap second
97 -- at 113 will not be counted in Leaps_Between, but it will be returned
98 -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
99 -- a leap second, the comparison should be:
101 -- End_Date >= Next_Leap_Sec;
103 -- After_Last_Leap is designed so that this comparison works without
104 -- having to first check if Next_Leap_Sec is a valid leap second.
106 function Duration_To_Time_Rep
is
107 new Ada
.Unchecked_Conversion
(Duration, Time_Rep
);
108 -- Convert a duration value into a time representation value
110 function Time_Rep_To_Duration
is
111 new Ada
.Unchecked_Conversion
(Time_Rep
, Duration);
112 -- Convert a time representation value into a duration value
118 -- An integer time duration. The type is used whenever a positive elapsed
119 -- duration is needed, for instance when splitting a time value. Here is
120 -- how Time_Rep and Time_Dur are related:
122 -- 'First Ada_Low Ada_High 'Last
123 -- Time_Rep: +-------+------------------------+---------+
124 -- Time_Dur: +------------------------+---------+
127 type Time_Dur
is range 0 .. 2 ** 63 - 1;
129 --------------------------
130 -- Leap seconds control --
131 --------------------------
134 pragma Import
(C
, Flag
, "__gl_leap_seconds_support");
135 -- This imported value is used to determine whether the compilation had
136 -- binder flag "-y" present which enables leap seconds. A value of zero
137 -- signifies no leap seconds support while a value of one enables the
140 Leap_Support
: constant Boolean := Flag
= 1;
141 -- The above flag controls the usage of leap seconds in all Ada.Calendar
144 Leap_Seconds_Count
: constant Natural := 23;
146 ---------------------
147 -- Local Constants --
148 ---------------------
150 Ada_Min_Year
: constant Year_Number
:= Year_Number
'First;
151 Secs_In_Four_Years
: constant := (3 * 365 + 366) * Secs_In_Day
;
152 Secs_In_Non_Leap_Year
: constant := 365 * Secs_In_Day
;
154 -- Lower and upper bound of Ada time. The zero (0) value of type Time is
155 -- positioned at year 2150. Note that the lower and upper bound account
156 -- for the non-leap centennial years.
158 Ada_Low
: constant Time_Rep
:= -(61 * 366 + 188 * 365) * Nanos_In_Day
;
159 Ada_High
: constant Time_Rep
:= (60 * 366 + 190 * 365) * Nanos_In_Day
;
161 -- Even though the upper bound of time is 2399-12-31 23:59:59.999999999
162 -- UTC, it must be increased to include all leap seconds.
164 Ada_High_And_Leaps
: constant Time_Rep
:=
165 Ada_High
+ Time_Rep
(Leap_Seconds_Count
) * Nano
;
167 -- Two constants used in the calculations of elapsed leap seconds.
168 -- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time
169 -- is earlier than Ada_Low in time zone +28.
171 End_Of_Time
: constant Time_Rep
:=
172 Ada_High
+ Time_Rep
(3) * Nanos_In_Day
;
173 Start_Of_Time
: constant Time_Rep
:=
174 Ada_Low
- Time_Rep
(3) * Nanos_In_Day
;
176 -- The Unix lower time bound expressed as nanoseconds since the
177 -- start of Ada time in UTC.
179 Unix_Min
: constant Time_Rep
:=
180 Ada_Low
+ Time_Rep
(17 * 366 + 52 * 365) * Nanos_In_Day
;
182 Cumulative_Days_Before_Month
:
183 constant array (Month_Number
) of Natural :=
184 (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
186 -- The following table contains the hard time values of all existing leap
187 -- seconds. The values are produced by the utility program xleaps.adb.
189 Leap_Second_Times
: constant array (1 .. Leap_Seconds_Count
) of Time_Rep
:=
190 (-5601484800000000000,
191 -5585587199000000000,
192 -5554051198000000000,
193 -5522515197000000000,
194 -5490979196000000000,
195 -5459356795000000000,
196 -5427820794000000000,
197 -5396284793000000000,
198 -5364748792000000000,
199 -5317487991000000000,
200 -5285951990000000000,
201 -5254415989000000000,
202 -5191257588000000000,
203 -5112287987000000000,
204 -5049129586000000000,
205 -5017593585000000000,
206 -4970332784000000000,
207 -4938796783000000000,
208 -4907260782000000000,
209 -4859827181000000000,
210 -4812566380000000000,
211 -4765132779000000000,
212 -4544207978000000000);
218 function "+" (Left
: Time
; Right
: Duration) return Time
is
219 pragma Unsuppress
(Overflow_Check
);
220 Left_N
: constant Time_Rep
:= Time_Rep
(Left
);
222 return Time
(Left_N
+ Duration_To_Time_Rep
(Right
));
224 when Constraint_Error
=>
228 function "+" (Left
: Duration; Right
: Time
) return Time
is
237 function "-" (Left
: Time
; Right
: Duration) return Time
is
238 pragma Unsuppress
(Overflow_Check
);
239 Left_N
: constant Time_Rep
:= Time_Rep
(Left
);
241 return Time
(Left_N
- Duration_To_Time_Rep
(Right
));
243 when Constraint_Error
=>
247 function "-" (Left
: Time
; Right
: Time
) return Duration is
248 pragma Unsuppress
(Overflow_Check
);
250 -- The bounds of type Duration expressed as time representations
252 Dur_Low
: constant Time_Rep
:= Duration_To_Time_Rep
(Duration'First);
253 Dur_High
: constant Time_Rep
:= Duration_To_Time_Rep
(Duration'Last);
258 Res_N
:= Time_Rep
(Left
) - Time_Rep
(Right
);
260 -- Due to the extended range of Ada time, "-" is capable of producing
261 -- results which may exceed the range of Duration. In order to prevent
262 -- the generation of bogus values by the Unchecked_Conversion, we apply
263 -- the following check.
266 or else Res_N
> Dur_High
271 return Time_Rep_To_Duration
(Res_N
);
273 when Constraint_Error
=>
281 function "<" (Left
, Right
: Time
) return Boolean is
283 return Time_Rep
(Left
) < Time_Rep
(Right
);
290 function "<=" (Left
, Right
: Time
) return Boolean is
292 return Time_Rep
(Left
) <= Time_Rep
(Right
);
299 function ">" (Left
, Right
: Time
) return Boolean is
301 return Time_Rep
(Left
) > Time_Rep
(Right
);
308 function ">=" (Left
, Right
: Time
) return Boolean is
310 return Time_Rep
(Left
) >= Time_Rep
(Right
);
313 ------------------------------
314 -- Check_Within_Time_Bounds --
315 ------------------------------
317 procedure Check_Within_Time_Bounds
(T
: Time_Rep
) is
320 if T
< Ada_Low
or else T
> Ada_High_And_Leaps
then
324 if T
< Ada_Low
or else T
> Ada_High
then
328 end Check_Within_Time_Bounds
;
334 function Clock
return Time
is
335 Elapsed_Leaps
: Natural;
336 Next_Leap_N
: Time_Rep
;
338 -- The system clock returns the time in UTC since the Unix Epoch of
339 -- 1970-01-01 00:00:00.0. We perform an origin shift to the Ada Epoch
340 -- by adding the number of nanoseconds between the two origins.
343 Duration_To_Time_Rep
(System
.OS_Primitives
.Clock
) +
347 -- If the target supports leap seconds, determine the number of leap
348 -- seconds elapsed until this moment.
351 Cumulative_Leap_Seconds
352 (Start_Of_Time
, Res_N
, Elapsed_Leaps
, Next_Leap_N
);
354 -- The system clock may fall exactly on a leap second
356 if Res_N
>= Next_Leap_N
then
357 Elapsed_Leaps
:= Elapsed_Leaps
+ 1;
360 -- The target does not support leap seconds
366 Res_N
:= Res_N
+ Time_Rep
(Elapsed_Leaps
) * Nano
;
371 -----------------------------
372 -- Cumulative_Leap_Seconds --
373 -----------------------------
375 procedure Cumulative_Leap_Seconds
376 (Start_Date
: Time_Rep
;
378 Elapsed_Leaps
: out Natural;
379 Next_Leap
: out Time_Rep
)
381 End_Index
: Positive;
382 End_T
: Time_Rep
:= End_Date
;
383 Start_Index
: Positive;
384 Start_T
: Time_Rep
:= Start_Date
;
387 -- Both input dates must be normalized to UTC
389 pragma Assert
(Leap_Support
and then End_Date
>= Start_Date
);
391 Next_Leap
:= End_Of_Time
;
393 -- Make sure that the end date does not exceed the upper bound
396 if End_Date
> Ada_High
then
400 -- Remove the sub seconds from both dates
402 Start_T
:= Start_T
- (Start_T
mod Nano
);
403 End_T
:= End_T
- (End_T
mod Nano
);
405 -- Some trivial cases:
406 -- Leap 1 . . . Leap N
407 -- ---+========+------+############+-------+========+-----
408 -- Start_T End_T Start_T End_T
410 if End_T
< Leap_Second_Times
(1) then
412 Next_Leap
:= Leap_Second_Times
(1);
415 elsif Start_T
> Leap_Second_Times
(Leap_Seconds_Count
) then
417 Next_Leap
:= End_Of_Time
;
421 -- Perform the calculations only if the start date is within the leap
422 -- second occurrences table.
424 if Start_T
<= Leap_Second_Times
(Leap_Seconds_Count
) then
427 -- +----+----+-- . . . --+-------+---+
428 -- | T1 | T2 | | N - 1 | N |
429 -- +----+----+-- . . . --+-------+---+
431 -- | Start_Index | End_Index
432 -- +-------------------+
435 -- The idea behind the algorithm is to iterate and find two
436 -- closest dates which are after Start_T and End_T. Their
437 -- corresponding index difference denotes the number of leap
442 exit when Leap_Second_Times
(Start_Index
) >= Start_T
;
443 Start_Index
:= Start_Index
+ 1;
446 End_Index
:= Start_Index
;
448 exit when End_Index
> Leap_Seconds_Count
449 or else Leap_Second_Times
(End_Index
) >= End_T
;
450 End_Index
:= End_Index
+ 1;
453 if End_Index
<= Leap_Seconds_Count
then
454 Next_Leap
:= Leap_Second_Times
(End_Index
);
457 Elapsed_Leaps
:= End_Index
- Start_Index
;
462 end Cumulative_Leap_Seconds
;
468 function Day
(Date
: Time
) return Day_Number
is
473 pragma Unreferenced
(Y
, M
, S
);
475 Split
(Date
, Y
, M
, D
, S
);
483 function Is_Leap
(Year
: Year_Number
) return Boolean is
485 -- Leap centennial years
487 if Year
mod 400 = 0 then
490 -- Non-leap centennial years
492 elsif Year
mod 100 = 0 then
498 return Year
mod 4 = 0;
506 function Month
(Date
: Time
) return Month_Number
is
511 pragma Unreferenced
(Y
, D
, S
);
513 Split
(Date
, Y
, M
, D
, S
);
521 function Seconds
(Date
: Time
) return Day_Duration
is
526 pragma Unreferenced
(Y
, M
, D
);
528 Split
(Date
, Y
, M
, D
, S
);
538 Year
: out Year_Number
;
539 Month
: out Month_Number
;
540 Day
: out Day_Number
;
541 Seconds
: out Day_Duration
)
549 pragma Unreferenced
(H
, M
, Se
, Ss
, Le
);
552 -- Even though the input time zone is UTC (0), the flag Is_Ada_05 will
553 -- ensure that Split picks up the local time zone.
555 Formatting_Operations
.Split
572 or else not Month
'Valid
573 or else not Day
'Valid
574 or else not Seconds
'Valid
586 Month
: Month_Number
;
588 Seconds
: Day_Duration
:= 0.0) return Time
590 -- The values in the following constants are irrelevant, they are just
591 -- placeholders; the choice of constructing a Day_Duration value is
592 -- controlled by the Use_Day_Secs flag.
594 H
: constant Integer := 1;
595 M
: constant Integer := 1;
596 Se
: constant Integer := 1;
597 Ss
: constant Duration := 0.1;
603 or else not Month
'Valid
604 or else not Day
'Valid
605 or else not Seconds
'Valid
610 -- Even though the input time zone is UTC (0), the flag Is_Ada_05 will
611 -- ensure that Split picks up the local time zone.
614 Formatting_Operations
.Time_Of
624 Use_Day_Secs
=> True,
633 function Year
(Date
: Time
) return Year_Number
is
638 pragma Unreferenced
(M
, D
, S
);
640 Split
(Date
, Y
, M
, D
, S
);
644 -- The following packages assume that Time is a signed 64 bit integer
645 -- type, the units are nanoseconds and the origin is the start of Ada
646 -- time (1901-01-01 00:00:00.0 UTC).
648 ---------------------------
649 -- Arithmetic_Operations --
650 ---------------------------
652 package body Arithmetic_Operations
is
658 function Add
(Date
: Time
; Days
: Long_Integer) return Time
is
659 pragma Unsuppress
(Overflow_Check
);
660 Date_N
: constant Time_Rep
:= Time_Rep
(Date
);
662 return Time
(Date_N
+ Time_Rep
(Days
) * Nanos_In_Day
);
664 when Constraint_Error
=>
675 Days
: out Long_Integer;
676 Seconds
: out Duration;
677 Leap_Seconds
: out Integer)
681 Elapsed_Leaps
: Natural;
683 Negate
: Boolean := False;
684 Next_Leap_N
: Time_Rep
;
686 Sub_Secs_Diff
: Time_Rep
;
689 -- Both input time values are assumed to be in UTC
691 if Left
>= Right
then
692 Later
:= Time_Rep
(Left
);
693 Earlier
:= Time_Rep
(Right
);
695 Later
:= Time_Rep
(Right
);
696 Earlier
:= Time_Rep
(Left
);
700 -- If the target supports leap seconds, process them
703 Cumulative_Leap_Seconds
704 (Earlier
, Later
, Elapsed_Leaps
, Next_Leap_N
);
706 if Later
>= Next_Leap_N
then
707 Elapsed_Leaps
:= Elapsed_Leaps
+ 1;
710 -- The target does not support leap seconds
716 -- Sub seconds processing. We add the resulting difference to one
717 -- of the input dates in order to account for any potential rounding
718 -- of the difference in the next step.
720 Sub_Secs_Diff
:= Later
mod Nano
- Earlier
mod Nano
;
721 Earlier
:= Earlier
+ Sub_Secs_Diff
;
722 Sub_Secs
:= Duration (Sub_Secs_Diff
) / Nano_F
;
724 -- Difference processing. This operation should be able to calculate
725 -- the difference between opposite values which are close to the end
726 -- and start of Ada time. To accommodate the large range, we convert
727 -- to seconds. This action may potentially round the two values and
728 -- either add or drop a second. We compensate for this issue in the
732 Time_Dur
(Later
/ Nano
- Earlier
/ Nano
) - Time_Dur
(Elapsed_Leaps
);
734 Days
:= Long_Integer (Res_Dur
/ Secs_In_Day
);
735 Seconds
:= Duration (Res_Dur
mod Secs_In_Day
) + Sub_Secs
;
736 Leap_Seconds
:= Integer (Elapsed_Leaps
);
742 if Leap_Seconds
/= 0 then
743 Leap_Seconds
:= -Leap_Seconds
;
752 function Subtract
(Date
: Time
; Days
: Long_Integer) return Time
is
753 pragma Unsuppress
(Overflow_Check
);
754 Date_N
: constant Time_Rep
:= Time_Rep
(Date
);
756 return Time
(Date_N
- Time_Rep
(Days
) * Nanos_In_Day
);
758 when Constraint_Error
=>
762 end Arithmetic_Operations
;
764 ---------------------------
765 -- Conversion_Operations --
766 ---------------------------
768 package body Conversion_Operations
is
770 Epoch_Offset
: constant Time_Rep
:=
771 (136 * 365 + 44 * 366) * Nanos_In_Day
;
772 -- The difference between 2150-1-1 UTC and 1970-1-1 UTC expressed in
773 -- nanoseconds. Note that year 2100 is non-leap.
779 function To_Ada_Time
(Unix_Time
: Long_Integer) return Time
is
780 pragma Unsuppress
(Overflow_Check
);
781 Unix_Rep
: constant Time_Rep
:= Time_Rep
(Unix_Time
) * Nano
;
783 return Time
(Unix_Rep
- Epoch_Offset
);
785 when Constraint_Error
=>
800 tm_isdst
: Integer) return Time
802 pragma Unsuppress
(Overflow_Check
);
804 Month
: Month_Number
;
813 Year
:= Year_Number
(1900 + tm_year
);
814 Month
:= Month_Number
(1 + tm_mon
);
815 Day
:= Day_Number
(tm_day
);
817 -- Step 1: Validity checks of input values
820 or else not Month
'Valid
821 or else not Day
'Valid
822 or else tm_hour
not in 0 .. 24
823 or else tm_min
not in 0 .. 59
824 or else tm_sec
not in 0 .. 60
825 or else tm_isdst
not in -1 .. 1
830 -- Step 2: Potential leap second
840 -- Step 3: Calculate the time value
844 (Formatting_Operations
.Time_Of
848 Day_Secs
=> 0.0, -- Time is given in h:m:s
852 Sub_Sec
=> 0.0, -- No precise sub second given
854 Use_Day_Secs
=> False, -- Time is given in h:m:s
855 Is_Ada_05
=> True, -- Force usage of explicit time zone
856 Time_Zone
=> 0)); -- Place the value in UTC
858 -- Step 4: Daylight Savings Time
861 Result
:= Result
+ Time_Rep
(3_600
) * Nano
;
864 return Time
(Result
);
867 when Constraint_Error
=>
876 (tv_sec
: Long_Integer;
877 tv_nsec
: Long_Integer) return Duration
879 pragma Unsuppress
(Overflow_Check
);
881 return Duration (tv_sec
) + Duration (tv_nsec
) / Nano_F
;
884 ------------------------
885 -- To_Struct_Timespec --
886 ------------------------
888 procedure To_Struct_Timespec
890 tv_sec
: out Long_Integer;
891 tv_nsec
: out Long_Integer)
893 pragma Unsuppress
(Overflow_Check
);
895 Nano_Secs
: Duration;
898 -- Seconds extraction, avoid potential rounding errors
901 tv_sec
:= Long_Integer (Secs
);
903 -- Nanoseconds extraction
905 Nano_Secs
:= D
- Duration (tv_sec
);
906 tv_nsec
:= Long_Integer (Nano_Secs
* Nano
);
907 end To_Struct_Timespec
;
913 procedure To_Struct_Tm
915 tm_year
: out Integer;
916 tm_mon
: out Integer;
917 tm_day
: out Integer;
918 tm_hour
: out Integer;
919 tm_min
: out Integer;
920 tm_sec
: out Integer)
922 pragma Unsuppress
(Overflow_Check
);
924 Month
: Month_Number
;
926 Day_Secs
: Day_Duration
;
931 -- Step 1: Split the input time
933 Formatting_Operations
.Split
934 (T
, Year
, Month
, tm_day
, Day_Secs
,
935 tm_hour
, tm_min
, Second
, Sub_Sec
, Leap_Sec
, True, 0);
937 -- Step 2: Correct the year and month
939 tm_year
:= Year
- 1900;
942 -- Step 3: Handle leap second occurrences
955 function To_Unix_Time
(Ada_Time
: Time
) return Long_Integer is
956 pragma Unsuppress
(Overflow_Check
);
957 Ada_Rep
: constant Time_Rep
:= Time_Rep
(Ada_Time
);
959 return Long_Integer ((Ada_Rep
+ Epoch_Offset
) / Nano
);
961 when Constraint_Error
=>
964 end Conversion_Operations
;
966 ----------------------
967 -- Delay_Operations --
968 ----------------------
970 package body Delay_Operations
is
976 function To_Duration
(Date
: Time
) return Duration is
977 Elapsed_Leaps
: Natural;
978 Next_Leap_N
: Time_Rep
;
982 Res_N
:= Time_Rep
(Date
);
984 -- If the target supports leap seconds, remove any leap seconds
985 -- elapsed up to the input date.
988 Cumulative_Leap_Seconds
989 (Start_Of_Time
, Res_N
, Elapsed_Leaps
, Next_Leap_N
);
991 -- The input time value may fall on a leap second occurrence
993 if Res_N
>= Next_Leap_N
then
994 Elapsed_Leaps
:= Elapsed_Leaps
+ 1;
997 -- The target does not support leap seconds
1003 Res_N
:= Res_N
- Time_Rep
(Elapsed_Leaps
) * Nano
;
1005 -- Perform a shift in origins, note that enforcing type Time on
1006 -- both operands will invoke Ada.Calendar."-".
1008 return Time
(Res_N
) - Time
(Unix_Min
);
1011 end Delay_Operations
;
1013 ---------------------------
1014 -- Formatting_Operations --
1015 ---------------------------
1017 package body Formatting_Operations
is
1023 function Day_Of_Week
(Date
: Time
) return Integer is
1034 pragma Unreferenced
(Ds
, H
, Mi
, Se
, Su
, Le
);
1036 Day_Count
: Long_Integer;
1041 Formatting_Operations
.Split
1055 -- Build a time value in the middle of the same day
1059 (Formatting_Operations
.Time_Of
1069 Use_Day_Secs
=> False,
1073 -- Determine the elapsed seconds since the start of Ada time
1075 Res_Dur
:= Time_Dur
(Res_N
/ Nano
- Ada_Low
/ Nano
);
1077 -- Count the number of days since the start of Ada time. 1901-1-1
1078 -- GMT was a Tuesday.
1080 Day_Count
:= Long_Integer (Res_Dur
/ Secs_In_Day
) + 1;
1082 return Integer (Day_Count
mod 7);
1091 Year
: out Year_Number
;
1092 Month
: out Month_Number
;
1093 Day
: out Day_Number
;
1094 Day_Secs
: out Day_Duration
;
1096 Minute
: out Integer;
1097 Second
: out Integer;
1098 Sub_Sec
: out Duration;
1099 Leap_Sec
: out Boolean;
1100 Is_Ada_05
: Boolean;
1101 Time_Zone
: Long_Integer)
1103 -- The following constants represent the number of nanoseconds
1104 -- elapsed since the start of Ada time to and including the non
1105 -- leap centennial years.
1107 Year_2101
: constant Time_Rep
:= Ada_Low
+
1108 Time_Rep
(49 * 366 + 151 * 365) * Nanos_In_Day
;
1109 Year_2201
: constant Time_Rep
:= Ada_Low
+
1110 Time_Rep
(73 * 366 + 227 * 365) * Nanos_In_Day
;
1111 Year_2301
: constant Time_Rep
:= Ada_Low
+
1112 Time_Rep
(97 * 366 + 303 * 365) * Nanos_In_Day
;
1114 Date_Dur
: Time_Dur
;
1116 Day_Seconds
: Natural;
1117 Elapsed_Leaps
: Natural;
1118 Four_Year_Segs
: Natural;
1119 Hour_Seconds
: Natural;
1120 Is_Leap_Year
: Boolean;
1121 Next_Leap_N
: Time_Rep
;
1122 Rem_Years
: Natural;
1123 Sub_Sec_N
: Time_Rep
;
1127 Date_N
:= Time_Rep
(Date
);
1129 -- Step 1: Leap seconds processing in UTC
1131 if Leap_Support
then
1132 Cumulative_Leap_Seconds
1133 (Start_Of_Time
, Date_N
, Elapsed_Leaps
, Next_Leap_N
);
1135 Leap_Sec
:= Date_N
>= Next_Leap_N
;
1138 Elapsed_Leaps
:= Elapsed_Leaps
+ 1;
1141 -- The target does not support leap seconds
1148 Date_N
:= Date_N
- Time_Rep
(Elapsed_Leaps
) * Nano
;
1150 -- Step 2: Time zone processing. This action converts the input date
1151 -- from GMT to the requested time zone.
1154 if Time_Zone
/= 0 then
1155 Date_N
:= Date_N
+ Time_Rep
(Time_Zone
) * 60 * Nano
;
1162 Off
: constant Long_Integer :=
1163 Time_Zones_Operations
.UTC_Time_Offset
(Time
(Date_N
));
1165 Date_N
:= Date_N
+ Time_Rep
(Off
) * Nano
;
1169 -- Step 3: Non-leap centennial year adjustment in local time zone
1171 -- In order for all divisions to work properly and to avoid more
1172 -- complicated arithmetic, we add fake February 29s to dates which
1173 -- occur after a non-leap centennial year.
1175 if Date_N
>= Year_2301
then
1176 Date_N
:= Date_N
+ Time_Rep
(3) * Nanos_In_Day
;
1178 elsif Date_N
>= Year_2201
then
1179 Date_N
:= Date_N
+ Time_Rep
(2) * Nanos_In_Day
;
1181 elsif Date_N
>= Year_2101
then
1182 Date_N
:= Date_N
+ Time_Rep
(1) * Nanos_In_Day
;
1185 -- Step 4: Sub second processing in local time zone
1187 Sub_Sec_N
:= Date_N
mod Nano
;
1188 Sub_Sec
:= Duration (Sub_Sec_N
) / Nano_F
;
1189 Date_N
:= Date_N
- Sub_Sec_N
;
1191 -- Convert Date_N into a time duration value, changing the units
1194 Date_Dur
:= Time_Dur
(Date_N
/ Nano
- Ada_Low
/ Nano
);
1196 -- Step 5: Year processing in local time zone. Determine the number
1197 -- of four year segments since the start of Ada time and the input
1200 Four_Year_Segs
:= Natural (Date_Dur
/ Secs_In_Four_Years
);
1202 if Four_Year_Segs
> 0 then
1203 Date_Dur
:= Date_Dur
- Time_Dur
(Four_Year_Segs
) *
1207 -- Calculate the remaining non-leap years
1209 Rem_Years
:= Natural (Date_Dur
/ Secs_In_Non_Leap_Year
);
1211 if Rem_Years
> 3 then
1215 Date_Dur
:= Date_Dur
- Time_Dur
(Rem_Years
) * Secs_In_Non_Leap_Year
;
1217 Year
:= Ada_Min_Year
+ Natural (4 * Four_Year_Segs
+ Rem_Years
);
1218 Is_Leap_Year
:= Is_Leap
(Year
);
1220 -- Step 6: Month and day processing in local time zone
1222 Year_Day
:= Natural (Date_Dur
/ Secs_In_Day
) + 1;
1226 -- Processing for months after January
1228 if Year_Day
> 31 then
1230 Year_Day
:= Year_Day
- 31;
1232 -- Processing for a new month or a leap February
1235 and then (not Is_Leap_Year
or else Year_Day
> 29)
1238 Year_Day
:= Year_Day
- 28;
1240 if Is_Leap_Year
then
1241 Year_Day
:= Year_Day
- 1;
1246 while Year_Day
> Days_In_Month
(Month
) loop
1247 Year_Day
:= Year_Day
- Days_In_Month
(Month
);
1253 -- Step 7: Hour, minute, second and sub second processing in local
1256 Day
:= Day_Number
(Year_Day
);
1257 Day_Seconds
:= Integer (Date_Dur
mod Secs_In_Day
);
1258 Day_Secs
:= Duration (Day_Seconds
) + Sub_Sec
;
1259 Hour
:= Day_Seconds
/ 3_600
;
1260 Hour_Seconds
:= Day_Seconds
mod 3_600
;
1261 Minute
:= Hour_Seconds
/ 60;
1262 Second
:= Hour_Seconds
mod 60;
1270 (Year
: Year_Number
;
1271 Month
: Month_Number
;
1273 Day_Secs
: Day_Duration
;
1278 Leap_Sec
: Boolean := False;
1279 Use_Day_Secs
: Boolean := False;
1280 Is_Ada_05
: Boolean := False;
1281 Time_Zone
: Long_Integer := 0) return Time
1284 Elapsed_Leaps
: Natural;
1285 Next_Leap_N
: Time_Rep
;
1287 Rounded_Res_N
: Time_Rep
;
1290 -- Step 1: Check whether the day, month and year form a valid date
1292 if Day
> Days_In_Month
(Month
)
1293 and then (Day
/= 29 or else Month
/= 2 or else not Is_Leap
(Year
))
1298 -- Start accumulating nanoseconds from the low bound of Ada time
1302 -- Step 2: Year processing and centennial year adjustment. Determine
1303 -- the number of four year segments since the start of Ada time and
1306 Count
:= (Year
- Year_Number
'First) / 4;
1307 Res_N
:= Res_N
+ Time_Rep
(Count
) * Secs_In_Four_Years
* Nano
;
1309 -- Note that non-leap centennial years are automatically considered
1310 -- leap in the operation above. An adjustment of several days is
1311 -- required to compensate for this.
1314 Res_N
:= Res_N
- Time_Rep
(3) * Nanos_In_Day
;
1316 elsif Year
> 2200 then
1317 Res_N
:= Res_N
- Time_Rep
(2) * Nanos_In_Day
;
1319 elsif Year
> 2100 then
1320 Res_N
:= Res_N
- Time_Rep
(1) * Nanos_In_Day
;
1323 -- Add the remaining non-leap years
1325 Count
:= (Year
- Year_Number
'First) mod 4;
1326 Res_N
:= Res_N
+ Time_Rep
(Count
) * Secs_In_Non_Leap_Year
* Nano
;
1328 -- Step 3: Day of month processing. Determine the number of days
1329 -- since the start of the current year. Do not add the current
1330 -- day since it has not elapsed yet.
1332 Count
:= Cumulative_Days_Before_Month
(Month
) + Day
- 1;
1334 -- The input year is leap and we have passed February
1342 Res_N
:= Res_N
+ Time_Rep
(Count
) * Nanos_In_Day
;
1344 -- Step 4: Hour, minute, second and sub second processing
1346 if Use_Day_Secs
then
1347 Res_N
:= Res_N
+ Duration_To_Time_Rep
(Day_Secs
);
1351 Time_Rep
(Hour
* 3_600
+ Minute
* 60 + Second
) * Nano
;
1353 if Sub_Sec
= 1.0 then
1354 Res_N
:= Res_N
+ Time_Rep
(1) * Nano
;
1356 Res_N
:= Res_N
+ Duration_To_Time_Rep
(Sub_Sec
);
1360 -- At this point, the generated time value should be withing the
1361 -- bounds of Ada time.
1363 Check_Within_Time_Bounds
(Res_N
);
1365 -- Step 4: Time zone processing. At this point we have built an
1366 -- arbitrary time value which is not related to any time zone.
1367 -- For simplicity, the time value is normalized to GMT, producing
1368 -- a uniform representation which can be treated by arithmetic
1369 -- operations for instance without any additional corrections.
1372 if Time_Zone
/= 0 then
1373 Res_N
:= Res_N
- Time_Rep
(Time_Zone
) * 60 * Nano
;
1380 Current_Off
: constant Long_Integer :=
1381 Time_Zones_Operations
.UTC_Time_Offset
1383 Current_Res_N
: constant Time_Rep
:=
1384 Res_N
- Time_Rep
(Current_Off
) * Nano
;
1385 Off
: constant Long_Integer :=
1386 Time_Zones_Operations
.UTC_Time_Offset
1387 (Time
(Current_Res_N
));
1389 Res_N
:= Res_N
- Time_Rep
(Off
) * Nano
;
1393 -- Step 5: Leap seconds processing in GMT
1395 if Leap_Support
then
1396 Cumulative_Leap_Seconds
1397 (Start_Of_Time
, Res_N
, Elapsed_Leaps
, Next_Leap_N
);
1399 Res_N
:= Res_N
+ Time_Rep
(Elapsed_Leaps
) * Nano
;
1401 -- An Ada 2005 caller requesting an explicit leap second or an
1402 -- Ada 95 caller accounting for an invisible leap second.
1405 or else Res_N
>= Next_Leap_N
1407 Res_N
:= Res_N
+ Time_Rep
(1) * Nano
;
1410 -- Leap second validity check
1412 Rounded_Res_N
:= Res_N
- (Res_N
mod Nano
);
1416 and then Rounded_Res_N
/= Next_Leap_N
1422 return Time
(Res_N
);
1425 end Formatting_Operations
;
1427 ---------------------------
1428 -- Time_Zones_Operations --
1429 ---------------------------
1431 package body Time_Zones_Operations
is
1433 -- The Unix time bounds in nanoseconds: 1970/1/1 .. 2037/1/1
1435 Unix_Min
: constant Time_Rep
:= Ada_Low
+
1436 Time_Rep
(17 * 366 + 52 * 365) * Nanos_In_Day
;
1438 Unix_Max
: constant Time_Rep
:= Ada_Low
+
1439 Time_Rep
(34 * 366 + 102 * 365) * Nanos_In_Day
+
1440 Time_Rep
(Leap_Seconds_Count
) * Nano
;
1442 -- The following constants denote February 28 during non-leap
1443 -- centennial years, the units are nanoseconds.
1445 T_2100_2_28
: constant Time_Rep
:= Ada_Low
+
1446 (Time_Rep
(49 * 366 + 150 * 365 + 59) * Secs_In_Day
+
1447 Time_Rep
(Leap_Seconds_Count
)) * Nano
;
1449 T_2200_2_28
: constant Time_Rep
:= Ada_Low
+
1450 (Time_Rep
(73 * 366 + 226 * 365 + 59) * Secs_In_Day
+
1451 Time_Rep
(Leap_Seconds_Count
)) * Nano
;
1453 T_2300_2_28
: constant Time_Rep
:= Ada_Low
+
1454 (Time_Rep
(97 * 366 + 302 * 365 + 59) * Secs_In_Day
+
1455 Time_Rep
(Leap_Seconds_Count
)) * Nano
;
1457 -- 56 years (14 leap years + 42 non leap years) in nanoseconds:
1459 Nanos_In_56_Years
: constant := (14 * 366 + 42 * 365) * Nanos_In_Day
;
1461 -- Base C types. There is no point dragging in Interfaces.C just for
1462 -- these four types.
1464 type char_Pointer
is access Character;
1465 subtype int
is Integer;
1466 subtype long
is Long_Integer;
1467 type long_Pointer
is access all long
;
1469 -- The Ada equivalent of struct tm and type time_t
1472 tm_sec
: int
; -- seconds after the minute (0 .. 60)
1473 tm_min
: int
; -- minutes after the hour (0 .. 59)
1474 tm_hour
: int
; -- hours since midnight (0 .. 24)
1475 tm_mday
: int
; -- day of the month (1 .. 31)
1476 tm_mon
: int
; -- months since January (0 .. 11)
1477 tm_year
: int
; -- years since 1900
1478 tm_wday
: int
; -- days since Sunday (0 .. 6)
1479 tm_yday
: int
; -- days since January 1 (0 .. 365)
1480 tm_isdst
: int
; -- Daylight Savings Time flag (-1 .. 1)
1481 tm_gmtoff
: long
; -- offset from UTC in seconds
1482 tm_zone
: char_Pointer
; -- timezone abbreviation
1485 type tm_Pointer
is access all tm
;
1487 subtype time_t
is long
;
1488 type time_t_Pointer
is access all time_t
;
1490 procedure localtime_tzoff
1491 (C
: time_t_Pointer
;
1493 off
: long_Pointer
);
1494 pragma Import
(C
, localtime_tzoff
, "__gnat_localtime_tzoff");
1495 -- This is a lightweight wrapper around the system library function
1496 -- localtime_r. Parameter 'off' captures the UTC offset which is either
1497 -- retrieved from the tm struct or calculated from the 'timezone' extern
1498 -- and the tm_isdst flag in the tm struct.
1500 ---------------------
1501 -- UTC_Time_Offset --
1502 ---------------------
1504 function UTC_Time_Offset
(Date
: Time
) return Long_Integer is
1505 Adj_Cent
: Integer := 0;
1507 Offset
: aliased long
;
1508 Secs_T
: aliased time_t
;
1509 Secs_TM
: aliased tm
;
1512 Date_N
:= Time_Rep
(Date
);
1514 -- Dates which are 56 years apart fall on the same day, day light
1515 -- saving and so on. Non-leap centennial years violate this rule by
1516 -- one day and as a consequence, special adjustment is needed.
1518 if Date_N
> T_2100_2_28
then
1519 if Date_N
> T_2200_2_28
then
1520 if Date_N
> T_2300_2_28
then
1531 if Adj_Cent
> 0 then
1532 Date_N
:= Date_N
- Time_Rep
(Adj_Cent
) * Nanos_In_Day
;
1535 -- Shift the date within bounds of Unix time
1537 while Date_N
< Unix_Min
loop
1538 Date_N
:= Date_N
+ Nanos_In_56_Years
;
1541 while Date_N
>= Unix_Max
loop
1542 Date_N
:= Date_N
- Nanos_In_56_Years
;
1545 -- Perform a shift in origins from Ada to Unix
1547 Date_N
:= Date_N
- Unix_Min
;
1549 -- Convert the date into seconds
1551 Secs_T
:= time_t
(Date_N
/ Nano
);
1554 (Secs_T
'Unchecked_Access,
1555 Secs_TM
'Unchecked_Access,
1556 Offset
'Unchecked_Access);
1559 end UTC_Time_Offset
;
1561 end Time_Zones_Operations
;
1563 -- Start of elaboration code for Ada.Calendar
1566 System
.OS_Primitives
.Initialize
;