1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . C A L E N D A R -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 10-- -- 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 3, 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. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Unchecked_Conversion; 33 34with Interfaces.C; 35 36with System.OS_Primitives; 37 38package body Ada.Calendar with 39 SPARK_Mode => Off 40is 41 42 -------------------------- 43 -- Implementation Notes -- 44 -------------------------- 45 46 -- In complex algorithms, some variables of type Ada.Calendar.Time carry 47 -- suffix _S or _N to denote units of seconds or nanoseconds. 48 -- 49 -- Because time is measured in different units and from different origins 50 -- on various targets, a system independent model is incorporated into 51 -- Ada.Calendar. The idea behind the design is to encapsulate all target 52 -- dependent machinery in a single package, thus providing a uniform 53 -- interface to all existing and any potential children. 54 55 -- package Ada.Calendar 56 -- procedure Split (5 parameters) -------+ 57 -- | Call from local routine 58 -- private | 59 -- package Formatting_Operations | 60 -- procedure Split (11 parameters) <--+ 61 -- end Formatting_Operations | 62 -- end Ada.Calendar | 63 -- | 64 -- package Ada.Calendar.Formatting | Call from child routine 65 -- procedure Split (9 or 10 parameters) -+ 66 -- end Ada.Calendar.Formatting 67 68 -- The behavior of the interfacing routines is controlled via various 69 -- flags. All new Ada 2005 types from children of Ada.Calendar are 70 -- emulated by a similar type. For instance, type Day_Number is replaced 71 -- by Integer in various routines. One ramification of this model is that 72 -- the caller site must perform validity checks on returned results. 73 -- The end result of this model is the lack of target specific files per 74 -- child of Ada.Calendar (e.g. a-calfor). 75 76 ----------------------- 77 -- Local Subprograms -- 78 ----------------------- 79 80 procedure Check_Within_Time_Bounds (T : Time_Rep); 81 -- Ensure that a time representation value falls withing the bounds of Ada 82 -- time. Leap seconds support is taken into account. 83 84 procedure Cumulative_Leap_Seconds 85 (Start_Date : Time_Rep; 86 End_Date : Time_Rep; 87 Elapsed_Leaps : out Natural; 88 Next_Leap : out Time_Rep); 89 -- Elapsed_Leaps is the sum of the leap seconds that have occurred on or 90 -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec 91 -- represents the next leap second occurrence on or after End_Date. If 92 -- there are no leaps seconds after End_Date, End_Of_Time is returned. 93 -- End_Of_Time can be used as End_Date to count all the leap seconds that 94 -- have occurred on or after Start_Date. 95 -- 96 -- Note: Any sub seconds of Start_Date and End_Date are discarded before 97 -- the calculations are done. For instance: if 113 seconds is a leap 98 -- second (it isn't) and 113.5 is input as an End_Date, the leap second 99 -- at 113 will not be counted in Leaps_Between, but it will be returned 100 -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is 101 -- a leap second, the comparison should be: 102 -- 103 -- End_Date >= Next_Leap_Sec; 104 -- 105 -- After_Last_Leap is designed so that this comparison works without 106 -- having to first check if Next_Leap_Sec is a valid leap second. 107 108 function Duration_To_Time_Rep is 109 new Ada.Unchecked_Conversion (Duration, Time_Rep); 110 -- Convert a duration value into a time representation value 111 112 function Time_Rep_To_Duration is 113 new Ada.Unchecked_Conversion (Time_Rep, Duration); 114 -- Convert a time representation value into a duration value 115 116 function UTC_Time_Offset 117 (Date : Time; 118 Is_Historic : Boolean) return Long_Integer; 119 -- This routine acts as an Ada wrapper around __gnat_localtime_tzoff which 120 -- in turn utilizes various OS-dependent mechanisms to calculate the time 121 -- zone offset of a date. Formal parameter Date represents an arbitrary 122 -- time stamp, either in the past, now, or in the future. If the flag 123 -- Is_Historic is set, this routine would try to calculate to the best of 124 -- the OS's abilities the time zone offset that was or will be in effect 125 -- on Date. If the flag is set to False, the routine returns the current 126 -- time zone with Date effectively set to Clock. 127 -- 128 -- NOTE: Targets which support localtime_r will aways return a historic 129 -- time zone even if flag Is_Historic is set to False because this is how 130 -- localtime_r operates. 131 132 ----------------- 133 -- Local Types -- 134 ----------------- 135 136 -- An integer time duration. The type is used whenever a positive elapsed 137 -- duration is needed, for instance when splitting a time value. Here is 138 -- how Time_Rep and Time_Dur are related: 139 140 -- 'First Ada_Low Ada_High 'Last 141 -- Time_Rep: +-------+------------------------+---------+ 142 -- Time_Dur: +------------------------+---------+ 143 -- 0 'Last 144 145 type Time_Dur is range 0 .. 2 ** 63 - 1; 146 147 -------------------------- 148 -- Leap seconds control -- 149 -------------------------- 150 151 Flag : Integer; 152 pragma Import (C, Flag, "__gl_leap_seconds_support"); 153 -- This imported value is used to determine whether the compilation had 154 -- binder flag "-y" present which enables leap seconds. A value of zero 155 -- signifies no leap seconds support while a value of one enables support. 156 157 Leap_Support : constant Boolean := (Flag = 1); 158 -- Flag to controls the usage of leap seconds in all Ada.Calendar routines 159 160 Leap_Seconds_Count : constant Natural := 25; 161 162 --------------------- 163 -- Local Constants -- 164 --------------------- 165 166 Ada_Min_Year : constant Year_Number := Year_Number'First; 167 Secs_In_Four_Years : constant := (3 * 365 + 366) * Secs_In_Day; 168 Secs_In_Non_Leap_Year : constant := 365 * Secs_In_Day; 169 Nanos_In_Four_Years : constant := Secs_In_Four_Years * Nano; 170 171 -- Lower and upper bound of Ada time. The zero (0) value of type Time is 172 -- positioned at year 2150. Note that the lower and upper bound account 173 -- for the non-leap centennial years. 174 175 Ada_Low : constant Time_Rep := -(61 * 366 + 188 * 365) * Nanos_In_Day; 176 Ada_High : constant Time_Rep := (60 * 366 + 190 * 365) * Nanos_In_Day; 177 178 -- Even though the upper bound of time is 2399-12-31 23:59:59.999999999 179 -- UTC, it must be increased to include all leap seconds. 180 181 Ada_High_And_Leaps : constant Time_Rep := 182 Ada_High + Time_Rep (Leap_Seconds_Count) * Nano; 183 184 -- Two constants used in the calculations of elapsed leap seconds. 185 -- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time 186 -- is earlier than Ada_Low in time zone +28. 187 188 End_Of_Time : constant Time_Rep := 189 Ada_High + Time_Rep (3) * Nanos_In_Day; 190 Start_Of_Time : constant Time_Rep := 191 Ada_Low - Time_Rep (3) * Nanos_In_Day; 192 193 -- The Unix lower time bound expressed as nanoseconds since the start of 194 -- Ada time in UTC. 195 196 Unix_Min : constant Time_Rep := 197 Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day; 198 199 -- The Unix upper time bound expressed as nanoseconds since the start of 200 -- Ada time in UTC. 201 202 Unix_Max : constant Time_Rep := 203 Ada_Low + Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day + 204 Time_Rep (Leap_Seconds_Count) * Nano; 205 206 Epoch_Offset : constant Time_Rep := (136 * 365 + 44 * 366) * Nanos_In_Day; 207 -- The difference between 2150-1-1 UTC and 1970-1-1 UTC expressed in 208 -- nanoseconds. Note that year 2100 is non-leap. 209 210 Cumulative_Days_Before_Month : 211 constant array (Month_Number) of Natural := 212 (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334); 213 214 -- The following table contains the hard time values of all existing leap 215 -- seconds. The values are produced by the utility program xleaps.adb. This 216 -- must be updated when additional leap second times are defined. 217 218 Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of Time_Rep := 219 (-5601484800000000000, 220 -5585587199000000000, 221 -5554051198000000000, 222 -5522515197000000000, 223 -5490979196000000000, 224 -5459356795000000000, 225 -5427820794000000000, 226 -5396284793000000000, 227 -5364748792000000000, 228 -5317487991000000000, 229 -5285951990000000000, 230 -5254415989000000000, 231 -5191257588000000000, 232 -5112287987000000000, 233 -5049129586000000000, 234 -5017593585000000000, 235 -4970332784000000000, 236 -4938796783000000000, 237 -4907260782000000000, 238 -4859827181000000000, 239 -4812566380000000000, 240 -4765132779000000000, 241 -4544207978000000000, 242 -4449513577000000000, 243 -4339180776000000000); 244 245 --------- 246 -- "+" -- 247 --------- 248 249 function "+" (Left : Time; Right : Duration) return Time is 250 pragma Unsuppress (Overflow_Check); 251 Left_N : constant Time_Rep := Time_Rep (Left); 252 begin 253 return Time (Left_N + Duration_To_Time_Rep (Right)); 254 exception 255 when Constraint_Error => 256 raise Time_Error; 257 end "+"; 258 259 function "+" (Left : Duration; Right : Time) return Time is 260 begin 261 return Right + Left; 262 end "+"; 263 264 --------- 265 -- "-" -- 266 --------- 267 268 function "-" (Left : Time; Right : Duration) return Time is 269 pragma Unsuppress (Overflow_Check); 270 Left_N : constant Time_Rep := Time_Rep (Left); 271 begin 272 return Time (Left_N - Duration_To_Time_Rep (Right)); 273 exception 274 when Constraint_Error => 275 raise Time_Error; 276 end "-"; 277 278 function "-" (Left : Time; Right : Time) return Duration is 279 pragma Unsuppress (Overflow_Check); 280 281 Dur_Low : constant Time_Rep := Duration_To_Time_Rep (Duration'First); 282 Dur_High : constant Time_Rep := Duration_To_Time_Rep (Duration'Last); 283 -- The bounds of type Duration expressed as time representations 284 285 Res_N : Time_Rep; 286 287 begin 288 Res_N := Time_Rep (Left) - Time_Rep (Right); 289 290 -- Due to the extended range of Ada time, "-" is capable of producing 291 -- results which may exceed the range of Duration. In order to prevent 292 -- the generation of bogus values by the Unchecked_Conversion, we apply 293 -- the following check. 294 295 if Res_N < Dur_Low or else Res_N > Dur_High then 296 raise Time_Error; 297 end if; 298 299 return Time_Rep_To_Duration (Res_N); 300 301 exception 302 when Constraint_Error => 303 raise Time_Error; 304 end "-"; 305 306 --------- 307 -- "<" -- 308 --------- 309 310 function "<" (Left, Right : Time) return Boolean is 311 begin 312 return Time_Rep (Left) < Time_Rep (Right); 313 end "<"; 314 315 ---------- 316 -- "<=" -- 317 ---------- 318 319 function "<=" (Left, Right : Time) return Boolean is 320 begin 321 return Time_Rep (Left) <= Time_Rep (Right); 322 end "<="; 323 324 --------- 325 -- ">" -- 326 --------- 327 328 function ">" (Left, Right : Time) return Boolean is 329 begin 330 return Time_Rep (Left) > Time_Rep (Right); 331 end ">"; 332 333 ---------- 334 -- ">=" -- 335 ---------- 336 337 function ">=" (Left, Right : Time) return Boolean is 338 begin 339 return Time_Rep (Left) >= Time_Rep (Right); 340 end ">="; 341 342 ------------------------------ 343 -- Check_Within_Time_Bounds -- 344 ------------------------------ 345 346 procedure Check_Within_Time_Bounds (T : Time_Rep) is 347 begin 348 if Leap_Support then 349 if T < Ada_Low or else T > Ada_High_And_Leaps then 350 raise Time_Error; 351 end if; 352 else 353 if T < Ada_Low or else T > Ada_High then 354 raise Time_Error; 355 end if; 356 end if; 357 end Check_Within_Time_Bounds; 358 359 ----------- 360 -- Clock -- 361 ----------- 362 363 function Clock return Time is 364 Elapsed_Leaps : Natural; 365 Next_Leap_N : Time_Rep; 366 367 -- The system clock returns the time in UTC since the Unix Epoch of 368 -- 1970-01-01 00:00:00.0. We perform an origin shift to the Ada Epoch 369 -- by adding the number of nanoseconds between the two origins. 370 371 Res_N : Time_Rep := 372 Duration_To_Time_Rep (System.OS_Primitives.Clock) + Unix_Min; 373 374 begin 375 -- If the target supports leap seconds, determine the number of leap 376 -- seconds elapsed until this moment. 377 378 if Leap_Support then 379 Cumulative_Leap_Seconds 380 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N); 381 382 -- The system clock may fall exactly on a leap second 383 384 if Res_N >= Next_Leap_N then 385 Elapsed_Leaps := Elapsed_Leaps + 1; 386 end if; 387 388 -- The target does not support leap seconds 389 390 else 391 Elapsed_Leaps := 0; 392 end if; 393 394 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano; 395 396 return Time (Res_N); 397 end Clock; 398 399 ----------------------------- 400 -- Cumulative_Leap_Seconds -- 401 ----------------------------- 402 403 procedure Cumulative_Leap_Seconds 404 (Start_Date : Time_Rep; 405 End_Date : Time_Rep; 406 Elapsed_Leaps : out Natural; 407 Next_Leap : out Time_Rep) 408 is 409 End_Index : Positive; 410 End_T : Time_Rep := End_Date; 411 Start_Index : Positive; 412 Start_T : Time_Rep := Start_Date; 413 414 begin 415 -- Both input dates must be normalized to UTC 416 417 pragma Assert (Leap_Support and then End_Date >= Start_Date); 418 419 Next_Leap := End_Of_Time; 420 421 -- Make sure that the end date does not exceed the upper bound 422 -- of Ada time. 423 424 if End_Date > Ada_High then 425 End_T := Ada_High; 426 end if; 427 428 -- Remove the sub seconds from both dates 429 430 Start_T := Start_T - (Start_T mod Nano); 431 End_T := End_T - (End_T mod Nano); 432 433 -- Some trivial cases: 434 -- Leap 1 . . . Leap N 435 -- ---+========+------+############+-------+========+----- 436 -- Start_T End_T Start_T End_T 437 438 if End_T < Leap_Second_Times (1) then 439 Elapsed_Leaps := 0; 440 Next_Leap := Leap_Second_Times (1); 441 return; 442 443 elsif Start_T > Leap_Second_Times (Leap_Seconds_Count) then 444 Elapsed_Leaps := 0; 445 Next_Leap := End_Of_Time; 446 return; 447 end if; 448 449 -- Perform the calculations only if the start date is within the leap 450 -- second occurrences table. 451 452 if Start_T <= Leap_Second_Times (Leap_Seconds_Count) then 453 454 -- 1 2 N - 1 N 455 -- +----+----+-- . . . --+-------+---+ 456 -- | T1 | T2 | | N - 1 | N | 457 -- +----+----+-- . . . --+-------+---+ 458 -- ^ ^ 459 -- | Start_Index | End_Index 460 -- +-------------------+ 461 -- Leaps_Between 462 463 -- The idea behind the algorithm is to iterate and find two 464 -- closest dates which are after Start_T and End_T. Their 465 -- corresponding index difference denotes the number of leap 466 -- seconds elapsed. 467 468 Start_Index := 1; 469 loop 470 exit when Leap_Second_Times (Start_Index) >= Start_T; 471 Start_Index := Start_Index + 1; 472 end loop; 473 474 End_Index := Start_Index; 475 loop 476 exit when End_Index > Leap_Seconds_Count 477 or else Leap_Second_Times (End_Index) >= End_T; 478 End_Index := End_Index + 1; 479 end loop; 480 481 if End_Index <= Leap_Seconds_Count then 482 Next_Leap := Leap_Second_Times (End_Index); 483 end if; 484 485 Elapsed_Leaps := End_Index - Start_Index; 486 487 else 488 Elapsed_Leaps := 0; 489 end if; 490 end Cumulative_Leap_Seconds; 491 492 --------- 493 -- Day -- 494 --------- 495 496 function Day (Date : Time) return Day_Number is 497 D : Day_Number; 498 Y : Year_Number; 499 M : Month_Number; 500 S : Day_Duration; 501 pragma Unreferenced (Y, M, S); 502 begin 503 Split (Date, Y, M, D, S); 504 return D; 505 end Day; 506 507 ------------- 508 -- Is_Leap -- 509 ------------- 510 511 function Is_Leap (Year : Year_Number) return Boolean is 512 begin 513 -- Leap centennial years 514 515 if Year mod 400 = 0 then 516 return True; 517 518 -- Non-leap centennial years 519 520 elsif Year mod 100 = 0 then 521 return False; 522 523 -- Regular years 524 525 else 526 return Year mod 4 = 0; 527 end if; 528 end Is_Leap; 529 530 ----------- 531 -- Month -- 532 ----------- 533 534 function Month (Date : Time) return Month_Number is 535 Y : Year_Number; 536 M : Month_Number; 537 D : Day_Number; 538 S : Day_Duration; 539 pragma Unreferenced (Y, D, S); 540 begin 541 Split (Date, Y, M, D, S); 542 return M; 543 end Month; 544 545 ------------- 546 -- Seconds -- 547 ------------- 548 549 function Seconds (Date : Time) return Day_Duration is 550 Y : Year_Number; 551 M : Month_Number; 552 D : Day_Number; 553 S : Day_Duration; 554 pragma Unreferenced (Y, M, D); 555 begin 556 Split (Date, Y, M, D, S); 557 return S; 558 end Seconds; 559 560 ----------- 561 -- Split -- 562 ----------- 563 564 procedure Split 565 (Date : Time; 566 Year : out Year_Number; 567 Month : out Month_Number; 568 Day : out Day_Number; 569 Seconds : out Day_Duration) 570 is 571 H : Integer; 572 M : Integer; 573 Se : Integer; 574 Ss : Duration; 575 Le : Boolean; 576 577 pragma Unreferenced (H, M, Se, Ss, Le); 578 579 begin 580 -- Even though the input time zone is UTC (0), the flag Use_TZ will 581 -- ensure that Split picks up the local time zone. 582 583 Formatting_Operations.Split 584 (Date => Date, 585 Year => Year, 586 Month => Month, 587 Day => Day, 588 Day_Secs => Seconds, 589 Hour => H, 590 Minute => M, 591 Second => Se, 592 Sub_Sec => Ss, 593 Leap_Sec => Le, 594 Use_TZ => False, 595 Is_Historic => True, 596 Time_Zone => 0); 597 598 -- Validity checks 599 600 if not Year'Valid or else 601 not Month'Valid or else 602 not Day'Valid or else 603 not Seconds'Valid 604 then 605 raise Time_Error; 606 end if; 607 end Split; 608 609 ------------- 610 -- Time_Of -- 611 ------------- 612 613 function Time_Of 614 (Year : Year_Number; 615 Month : Month_Number; 616 Day : Day_Number; 617 Seconds : Day_Duration := 0.0) return Time 618 is 619 -- The values in the following constants are irrelevant, they are just 620 -- placeholders; the choice of constructing a Day_Duration value is 621 -- controlled by the Use_Day_Secs flag. 622 623 H : constant Integer := 1; 624 M : constant Integer := 1; 625 Se : constant Integer := 1; 626 Ss : constant Duration := 0.1; 627 628 begin 629 -- Validity checks 630 631 if not Year'Valid or else 632 not Month'Valid or else 633 not Day'Valid or else 634 not Seconds'Valid 635 then 636 raise Time_Error; 637 end if; 638 639 -- Even though the input time zone is UTC (0), the flag Use_TZ will 640 -- ensure that Split picks up the local time zone. 641 642 return 643 Formatting_Operations.Time_Of 644 (Year => Year, 645 Month => Month, 646 Day => Day, 647 Day_Secs => Seconds, 648 Hour => H, 649 Minute => M, 650 Second => Se, 651 Sub_Sec => Ss, 652 Leap_Sec => False, 653 Use_Day_Secs => True, 654 Use_TZ => False, 655 Is_Historic => True, 656 Time_Zone => 0); 657 end Time_Of; 658 659 --------------------- 660 -- UTC_Time_Offset -- 661 --------------------- 662 663 function UTC_Time_Offset 664 (Date : Time; 665 Is_Historic : Boolean) return Long_Integer 666 is 667 -- The following constants denote February 28 during non-leap centennial 668 -- years, the units are nanoseconds. 669 670 T_2100_2_28 : constant Time_Rep := Ada_Low + 671 (Time_Rep (49 * 366 + 150 * 365 + 59) * Secs_In_Day + 672 Time_Rep (Leap_Seconds_Count)) * Nano; 673 674 T_2200_2_28 : constant Time_Rep := Ada_Low + 675 (Time_Rep (73 * 366 + 226 * 365 + 59) * Secs_In_Day + 676 Time_Rep (Leap_Seconds_Count)) * Nano; 677 678 T_2300_2_28 : constant Time_Rep := Ada_Low + 679 (Time_Rep (97 * 366 + 302 * 365 + 59) * Secs_In_Day + 680 Time_Rep (Leap_Seconds_Count)) * Nano; 681 682 -- 56 years (14 leap years + 42 non-leap years) in nanoseconds: 683 684 Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day; 685 686 type int_Pointer is access all Interfaces.C.int; 687 type long_Pointer is access all Interfaces.C.long; 688 689 type time_t is 690 range -(2 ** (Standard'Address_Size - Integer'(1))) .. 691 +(2 ** (Standard'Address_Size - Integer'(1)) - 1); 692 type time_t_Pointer is access all time_t; 693 694 procedure localtime_tzoff 695 (timer : time_t_Pointer; 696 is_historic : int_Pointer; 697 off : long_Pointer); 698 pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff"); 699 -- This routine is a interfacing wrapper around the library function 700 -- __gnat_localtime_tzoff. Parameter 'timer' represents a Unix-based 701 -- time equivalent of the input date. If flag 'is_historic' is set, this 702 -- routine would try to calculate to the best of the OS's abilities the 703 -- time zone offset that was or will be in effect on 'timer'. If the 704 -- flag is set to False, the routine returns the current time zone 705 -- regardless of what 'timer' designates. Parameter 'off' captures the 706 -- UTC offset of 'timer'. 707 708 Adj_Cent : Integer; 709 Date_N : Time_Rep; 710 Flag : aliased Interfaces.C.int; 711 Offset : aliased Interfaces.C.long; 712 Secs_T : aliased time_t; 713 714 -- Start of processing for UTC_Time_Offset 715 716 begin 717 Date_N := Time_Rep (Date); 718 719 -- Dates which are 56 years apart fall on the same day, day light saving 720 -- and so on. Non-leap centennial years violate this rule by one day and 721 -- as a consequence, special adjustment is needed. 722 723 Adj_Cent := 724 (if Date_N <= T_2100_2_28 then 0 725 elsif Date_N <= T_2200_2_28 then 1 726 elsif Date_N <= T_2300_2_28 then 2 727 else 3); 728 729 if Adj_Cent > 0 then 730 Date_N := Date_N - Time_Rep (Adj_Cent) * Nanos_In_Day; 731 end if; 732 733 -- Shift the date within bounds of Unix time 734 735 while Date_N < Unix_Min loop 736 Date_N := Date_N + Nanos_In_56_Years; 737 end loop; 738 739 while Date_N >= Unix_Max loop 740 Date_N := Date_N - Nanos_In_56_Years; 741 end loop; 742 743 -- Perform a shift in origins from Ada to Unix 744 745 Date_N := Date_N - Unix_Min; 746 747 -- Convert the date into seconds 748 749 Secs_T := time_t (Date_N / Nano); 750 751 -- Determine whether to treat the input date as historical or not. A 752 -- value of "0" signifies that the date is NOT historic. 753 754 Flag := (if Is_Historic then 1 else 0); 755 756 localtime_tzoff 757 (Secs_T'Unchecked_Access, 758 Flag'Unchecked_Access, 759 Offset'Unchecked_Access); 760 761 return Long_Integer (Offset); 762 end UTC_Time_Offset; 763 764 ---------- 765 -- Year -- 766 ---------- 767 768 function Year (Date : Time) return Year_Number is 769 Y : Year_Number; 770 M : Month_Number; 771 D : Day_Number; 772 S : Day_Duration; 773 pragma Unreferenced (M, D, S); 774 begin 775 Split (Date, Y, M, D, S); 776 return Y; 777 end Year; 778 779 -- The following packages assume that Time is a signed 64 bit integer 780 -- type, the units are nanoseconds and the origin is the start of Ada 781 -- time (1901-01-01 00:00:00.0 UTC). 782 783 --------------------------- 784 -- Arithmetic_Operations -- 785 --------------------------- 786 787 package body Arithmetic_Operations is 788 789 --------- 790 -- Add -- 791 --------- 792 793 function Add (Date : Time; Days : Long_Integer) return Time is 794 pragma Unsuppress (Overflow_Check); 795 Date_N : constant Time_Rep := Time_Rep (Date); 796 begin 797 return Time (Date_N + Time_Rep (Days) * Nanos_In_Day); 798 exception 799 when Constraint_Error => 800 raise Time_Error; 801 end Add; 802 803 ---------------- 804 -- Difference -- 805 ---------------- 806 807 procedure Difference 808 (Left : Time; 809 Right : Time; 810 Days : out Long_Integer; 811 Seconds : out Duration; 812 Leap_Seconds : out Integer) 813 is 814 Res_Dur : Time_Dur; 815 Earlier : Time_Rep; 816 Elapsed_Leaps : Natural; 817 Later : Time_Rep; 818 Negate : Boolean := False; 819 Next_Leap_N : Time_Rep; 820 Sub_Secs : Duration; 821 Sub_Secs_Diff : Time_Rep; 822 823 begin 824 -- Both input time values are assumed to be in UTC 825 826 if Left >= Right then 827 Later := Time_Rep (Left); 828 Earlier := Time_Rep (Right); 829 else 830 Later := Time_Rep (Right); 831 Earlier := Time_Rep (Left); 832 Negate := True; 833 end if; 834 835 -- If the target supports leap seconds, process them 836 837 if Leap_Support then 838 Cumulative_Leap_Seconds 839 (Earlier, Later, Elapsed_Leaps, Next_Leap_N); 840 841 if Later >= Next_Leap_N then 842 Elapsed_Leaps := Elapsed_Leaps + 1; 843 end if; 844 845 -- The target does not support leap seconds 846 847 else 848 Elapsed_Leaps := 0; 849 end if; 850 851 -- Sub seconds processing. We add the resulting difference to one 852 -- of the input dates in order to account for any potential rounding 853 -- of the difference in the next step. 854 855 Sub_Secs_Diff := Later mod Nano - Earlier mod Nano; 856 Earlier := Earlier + Sub_Secs_Diff; 857 Sub_Secs := Duration (Sub_Secs_Diff) / Nano_F; 858 859 -- Difference processing. This operation should be able to calculate 860 -- the difference between opposite values which are close to the end 861 -- and start of Ada time. To accommodate the large range, we convert 862 -- to seconds. This action may potentially round the two values and 863 -- either add or drop a second. We compensate for this issue in the 864 -- previous step. 865 866 Res_Dur := 867 Time_Dur (Later / Nano - Earlier / Nano) - Time_Dur (Elapsed_Leaps); 868 869 Days := Long_Integer (Res_Dur / Secs_In_Day); 870 Seconds := Duration (Res_Dur mod Secs_In_Day) + Sub_Secs; 871 Leap_Seconds := Integer (Elapsed_Leaps); 872 873 if Negate then 874 Days := -Days; 875 Seconds := -Seconds; 876 877 if Leap_Seconds /= 0 then 878 Leap_Seconds := -Leap_Seconds; 879 end if; 880 end if; 881 end Difference; 882 883 -------------- 884 -- Subtract -- 885 -------------- 886 887 function Subtract (Date : Time; Days : Long_Integer) return Time is 888 pragma Unsuppress (Overflow_Check); 889 Date_N : constant Time_Rep := Time_Rep (Date); 890 begin 891 return Time (Date_N - Time_Rep (Days) * Nanos_In_Day); 892 exception 893 when Constraint_Error => 894 raise Time_Error; 895 end Subtract; 896 897 end Arithmetic_Operations; 898 899 --------------------------- 900 -- Conversion_Operations -- 901 --------------------------- 902 903 package body Conversion_Operations is 904 905 ----------------- 906 -- To_Ada_Time -- 907 ----------------- 908 909 function To_Ada_Time (Unix_Time : Long_Integer) return Time is 910 pragma Unsuppress (Overflow_Check); 911 Unix_Rep : constant Time_Rep := Time_Rep (Unix_Time) * Nano; 912 begin 913 return Time (Unix_Rep - Epoch_Offset); 914 exception 915 when Constraint_Error => 916 raise Time_Error; 917 end To_Ada_Time; 918 919 ----------------- 920 -- To_Ada_Time -- 921 ----------------- 922 923 function To_Ada_Time 924 (tm_year : Integer; 925 tm_mon : Integer; 926 tm_day : Integer; 927 tm_hour : Integer; 928 tm_min : Integer; 929 tm_sec : Integer; 930 tm_isdst : Integer) return Time 931 is 932 pragma Unsuppress (Overflow_Check); 933 Year : Year_Number; 934 Month : Month_Number; 935 Day : Day_Number; 936 Second : Integer; 937 Leap : Boolean; 938 Result : Time_Rep; 939 940 begin 941 -- Input processing 942 943 Year := Year_Number (1900 + tm_year); 944 Month := Month_Number (1 + tm_mon); 945 Day := Day_Number (tm_day); 946 947 -- Step 1: Validity checks of input values 948 949 if not Year'Valid or else not Month'Valid or else not Day'Valid 950 or else tm_hour not in 0 .. 24 951 or else tm_min not in 0 .. 59 952 or else tm_sec not in 0 .. 60 953 or else tm_isdst not in -1 .. 1 954 then 955 raise Time_Error; 956 end if; 957 958 -- Step 2: Potential leap second 959 960 if tm_sec = 60 then 961 Leap := True; 962 Second := 59; 963 else 964 Leap := False; 965 Second := tm_sec; 966 end if; 967 968 -- Step 3: Calculate the time value 969 970 Result := 971 Time_Rep 972 (Formatting_Operations.Time_Of 973 (Year => Year, 974 Month => Month, 975 Day => Day, 976 Day_Secs => 0.0, -- Time is given in h:m:s 977 Hour => tm_hour, 978 Minute => tm_min, 979 Second => Second, 980 Sub_Sec => 0.0, -- No precise sub second given 981 Leap_Sec => Leap, 982 Use_Day_Secs => False, -- Time is given in h:m:s 983 Use_TZ => True, -- Force usage of explicit time zone 984 Is_Historic => True, 985 Time_Zone => 0)); -- Place the value in UTC 986 987 -- Step 4: Daylight Savings Time 988 989 if tm_isdst = 1 then 990 Result := Result + Time_Rep (3_600) * Nano; 991 end if; 992 993 return Time (Result); 994 995 exception 996 when Constraint_Error => 997 raise Time_Error; 998 end To_Ada_Time; 999 1000 ----------------- 1001 -- To_Duration -- 1002 ----------------- 1003 1004 function To_Duration 1005 (tv_sec : Long_Integer; 1006 tv_nsec : Long_Integer) return Duration 1007 is 1008 pragma Unsuppress (Overflow_Check); 1009 begin 1010 return Duration (tv_sec) + Duration (tv_nsec) / Nano_F; 1011 end To_Duration; 1012 1013 ------------------------ 1014 -- To_Struct_Timespec -- 1015 ------------------------ 1016 1017 procedure To_Struct_Timespec 1018 (D : Duration; 1019 tv_sec : out Long_Integer; 1020 tv_nsec : out Long_Integer) 1021 is 1022 pragma Unsuppress (Overflow_Check); 1023 Secs : Duration; 1024 Nano_Secs : Duration; 1025 1026 begin 1027 -- Seconds extraction, avoid potential rounding errors 1028 1029 Secs := D - 0.5; 1030 tv_sec := Long_Integer (Secs); 1031 1032 -- Nanoseconds extraction 1033 1034 Nano_Secs := D - Duration (tv_sec); 1035 tv_nsec := Long_Integer (Nano_Secs * Nano); 1036 end To_Struct_Timespec; 1037 1038 ------------------ 1039 -- To_Struct_Tm -- 1040 ------------------ 1041 1042 procedure To_Struct_Tm 1043 (T : Time; 1044 tm_year : out Integer; 1045 tm_mon : out Integer; 1046 tm_day : out Integer; 1047 tm_hour : out Integer; 1048 tm_min : out Integer; 1049 tm_sec : out Integer) 1050 is 1051 pragma Unsuppress (Overflow_Check); 1052 Year : Year_Number; 1053 Month : Month_Number; 1054 Second : Integer; 1055 Day_Secs : Day_Duration; 1056 Sub_Sec : Duration; 1057 Leap_Sec : Boolean; 1058 1059 begin 1060 -- Step 1: Split the input time 1061 1062 Formatting_Operations.Split 1063 (Date => T, 1064 Year => Year, 1065 Month => Month, 1066 Day => tm_day, 1067 Day_Secs => Day_Secs, 1068 Hour => tm_hour, 1069 Minute => tm_min, 1070 Second => Second, 1071 Sub_Sec => Sub_Sec, 1072 Leap_Sec => Leap_Sec, 1073 Use_TZ => True, 1074 Is_Historic => False, 1075 Time_Zone => 0); 1076 1077 -- Step 2: Correct the year and month 1078 1079 tm_year := Year - 1900; 1080 tm_mon := Month - 1; 1081 1082 -- Step 3: Handle leap second occurrences 1083 1084 tm_sec := (if Leap_Sec then 60 else Second); 1085 end To_Struct_Tm; 1086 1087 ------------------ 1088 -- To_Unix_Time -- 1089 ------------------ 1090 1091 function To_Unix_Time (Ada_Time : Time) return Long_Integer is 1092 pragma Unsuppress (Overflow_Check); 1093 Ada_Rep : constant Time_Rep := Time_Rep (Ada_Time); 1094 begin 1095 return Long_Integer ((Ada_Rep + Epoch_Offset) / Nano); 1096 exception 1097 when Constraint_Error => 1098 raise Time_Error; 1099 end To_Unix_Time; 1100 end Conversion_Operations; 1101 1102 ---------------------- 1103 -- Delay_Operations -- 1104 ---------------------- 1105 1106 package body Delay_Operations is 1107 1108 ----------------- 1109 -- To_Duration -- 1110 ----------------- 1111 1112 function To_Duration (Date : Time) return Duration is 1113 pragma Unsuppress (Overflow_Check); 1114 1115 Safe_Ada_High : constant Time_Rep := Ada_High - Epoch_Offset; 1116 -- This value represents a "safe" end of time. In order to perform a 1117 -- proper conversion to Unix duration, we will have to shift origins 1118 -- at one point. For very distant dates, this means an overflow check 1119 -- failure. To prevent this, the function returns the "safe" end of 1120 -- time (roughly 2219) which is still distant enough. 1121 1122 Elapsed_Leaps : Natural; 1123 Next_Leap_N : Time_Rep; 1124 Res_N : Time_Rep; 1125 1126 begin 1127 Res_N := Time_Rep (Date); 1128 1129 -- Step 1: If the target supports leap seconds, remove any leap 1130 -- seconds elapsed up to the input date. 1131 1132 if Leap_Support then 1133 Cumulative_Leap_Seconds 1134 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N); 1135 1136 -- The input time value may fall on a leap second occurrence 1137 1138 if Res_N >= Next_Leap_N then 1139 Elapsed_Leaps := Elapsed_Leaps + 1; 1140 end if; 1141 1142 -- The target does not support leap seconds 1143 1144 else 1145 Elapsed_Leaps := 0; 1146 end if; 1147 1148 Res_N := Res_N - Time_Rep (Elapsed_Leaps) * Nano; 1149 1150 -- Step 2: Perform a shift in origins to obtain a Unix equivalent of 1151 -- the input. Guard against very large delay values such as the end 1152 -- of time since the computation will overflow. 1153 1154 Res_N := (if Res_N > Safe_Ada_High then Safe_Ada_High 1155 else Res_N + Epoch_Offset); 1156 1157 return Time_Rep_To_Duration (Res_N); 1158 end To_Duration; 1159 1160 end Delay_Operations; 1161 1162 --------------------------- 1163 -- Formatting_Operations -- 1164 --------------------------- 1165 1166 package body Formatting_Operations is 1167 1168 ----------------- 1169 -- Day_Of_Week -- 1170 ----------------- 1171 1172 function Day_Of_Week (Date : Time) return Integer is 1173 Date_N : constant Time_Rep := Time_Rep (Date); 1174 Time_Zone : constant Long_Integer := UTC_Time_Offset (Date, True); 1175 Ada_Low_N : Time_Rep; 1176 Day_Count : Long_Integer; 1177 Day_Dur : Time_Dur; 1178 High_N : Time_Rep; 1179 Low_N : Time_Rep; 1180 1181 begin 1182 -- As declared, the Ada Epoch is set in UTC. For this calculation to 1183 -- work properly, both the Epoch and the input date must be in the 1184 -- same time zone. The following places the Epoch in the input date's 1185 -- time zone. 1186 1187 Ada_Low_N := Ada_Low - Time_Rep (Time_Zone) * Nano; 1188 1189 if Date_N > Ada_Low_N then 1190 High_N := Date_N; 1191 Low_N := Ada_Low_N; 1192 else 1193 High_N := Ada_Low_N; 1194 Low_N := Date_N; 1195 end if; 1196 1197 -- Determine the elapsed seconds since the start of Ada time 1198 1199 Day_Dur := Time_Dur (High_N / Nano - Low_N / Nano); 1200 1201 -- Count the number of days since the start of Ada time. 1901-01-01 1202 -- GMT was a Tuesday. 1203 1204 Day_Count := Long_Integer (Day_Dur / Secs_In_Day) + 1; 1205 1206 return Integer (Day_Count mod 7); 1207 end Day_Of_Week; 1208 1209 ----------- 1210 -- Split -- 1211 ----------- 1212 1213 procedure Split 1214 (Date : Time; 1215 Year : out Year_Number; 1216 Month : out Month_Number; 1217 Day : out Day_Number; 1218 Day_Secs : out Day_Duration; 1219 Hour : out Integer; 1220 Minute : out Integer; 1221 Second : out Integer; 1222 Sub_Sec : out Duration; 1223 Leap_Sec : out Boolean; 1224 Use_TZ : Boolean; 1225 Is_Historic : Boolean; 1226 Time_Zone : Long_Integer) 1227 is 1228 -- The following constants represent the number of nanoseconds 1229 -- elapsed since the start of Ada time to and including the non 1230 -- leap centennial years. 1231 1232 Year_2101 : constant Time_Rep := Ada_Low + 1233 Time_Rep (49 * 366 + 151 * 365) * Nanos_In_Day; 1234 Year_2201 : constant Time_Rep := Ada_Low + 1235 Time_Rep (73 * 366 + 227 * 365) * Nanos_In_Day; 1236 Year_2301 : constant Time_Rep := Ada_Low + 1237 Time_Rep (97 * 366 + 303 * 365) * Nanos_In_Day; 1238 1239 Date_Dur : Time_Dur; 1240 Date_N : Time_Rep; 1241 Day_Seconds : Natural; 1242 Elapsed_Leaps : Natural; 1243 Four_Year_Segs : Natural; 1244 Hour_Seconds : Natural; 1245 Is_Leap_Year : Boolean; 1246 Next_Leap_N : Time_Rep; 1247 Rem_Years : Natural; 1248 Sub_Sec_N : Time_Rep; 1249 Year_Day : Natural; 1250 1251 begin 1252 Date_N := Time_Rep (Date); 1253 1254 -- Step 1: Leap seconds processing in UTC 1255 1256 if Leap_Support then 1257 Cumulative_Leap_Seconds 1258 (Start_Of_Time, Date_N, Elapsed_Leaps, Next_Leap_N); 1259 1260 Leap_Sec := Date_N >= Next_Leap_N; 1261 1262 if Leap_Sec then 1263 Elapsed_Leaps := Elapsed_Leaps + 1; 1264 end if; 1265 1266 -- The target does not support leap seconds 1267 1268 else 1269 Elapsed_Leaps := 0; 1270 Leap_Sec := False; 1271 end if; 1272 1273 Date_N := Date_N - Time_Rep (Elapsed_Leaps) * Nano; 1274 1275 -- Step 2: Time zone processing. This action converts the input date 1276 -- from GMT to the requested time zone. Applies from Ada 2005 on. 1277 1278 if Use_TZ then 1279 if Time_Zone /= 0 then 1280 Date_N := Date_N + Time_Rep (Time_Zone) * 60 * Nano; 1281 end if; 1282 1283 -- Ada 83 and 95 1284 1285 else 1286 declare 1287 Off : constant Long_Integer := 1288 UTC_Time_Offset (Time (Date_N), Is_Historic); 1289 1290 begin 1291 Date_N := Date_N + Time_Rep (Off) * Nano; 1292 end; 1293 end if; 1294 1295 -- Step 3: Non-leap centennial year adjustment in local time zone 1296 1297 -- In order for all divisions to work properly and to avoid more 1298 -- complicated arithmetic, we add fake February 29s to dates which 1299 -- occur after a non-leap centennial year. 1300 1301 if Date_N >= Year_2301 then 1302 Date_N := Date_N + Time_Rep (3) * Nanos_In_Day; 1303 1304 elsif Date_N >= Year_2201 then 1305 Date_N := Date_N + Time_Rep (2) * Nanos_In_Day; 1306 1307 elsif Date_N >= Year_2101 then 1308 Date_N := Date_N + Time_Rep (1) * Nanos_In_Day; 1309 end if; 1310 1311 -- Step 4: Sub second processing in local time zone 1312 1313 Sub_Sec_N := Date_N mod Nano; 1314 Sub_Sec := Duration (Sub_Sec_N) / Nano_F; 1315 Date_N := Date_N - Sub_Sec_N; 1316 1317 -- Convert Date_N into a time duration value, changing the units 1318 -- to seconds. 1319 1320 Date_Dur := Time_Dur (Date_N / Nano - Ada_Low / Nano); 1321 1322 -- Step 5: Year processing in local time zone. Determine the number 1323 -- of four year segments since the start of Ada time and the input 1324 -- date. 1325 1326 Four_Year_Segs := Natural (Date_Dur / Secs_In_Four_Years); 1327 1328 if Four_Year_Segs > 0 then 1329 Date_Dur := Date_Dur - Time_Dur (Four_Year_Segs) * 1330 Secs_In_Four_Years; 1331 end if; 1332 1333 -- Calculate the remaining non-leap years 1334 1335 Rem_Years := Natural (Date_Dur / Secs_In_Non_Leap_Year); 1336 1337 if Rem_Years > 3 then 1338 Rem_Years := 3; 1339 end if; 1340 1341 Date_Dur := Date_Dur - Time_Dur (Rem_Years) * Secs_In_Non_Leap_Year; 1342 1343 Year := Ada_Min_Year + Natural (4 * Four_Year_Segs + Rem_Years); 1344 Is_Leap_Year := Is_Leap (Year); 1345 1346 -- Step 6: Month and day processing in local time zone 1347 1348 Year_Day := Natural (Date_Dur / Secs_In_Day) + 1; 1349 1350 Month := 1; 1351 1352 -- Processing for months after January 1353 1354 if Year_Day > 31 then 1355 Month := 2; 1356 Year_Day := Year_Day - 31; 1357 1358 -- Processing for a new month or a leap February 1359 1360 if Year_Day > 28 1361 and then (not Is_Leap_Year or else Year_Day > 29) 1362 then 1363 Month := 3; 1364 Year_Day := Year_Day - 28; 1365 1366 if Is_Leap_Year then 1367 Year_Day := Year_Day - 1; 1368 end if; 1369 1370 -- Remaining months 1371 1372 while Year_Day > Days_In_Month (Month) loop 1373 Year_Day := Year_Day - Days_In_Month (Month); 1374 Month := Month + 1; 1375 end loop; 1376 end if; 1377 end if; 1378 1379 -- Step 7: Hour, minute, second and sub second processing in local 1380 -- time zone. 1381 1382 Day := Day_Number (Year_Day); 1383 Day_Seconds := Integer (Date_Dur mod Secs_In_Day); 1384 Day_Secs := Duration (Day_Seconds) + Sub_Sec; 1385 Hour := Day_Seconds / 3_600; 1386 Hour_Seconds := Day_Seconds mod 3_600; 1387 Minute := Hour_Seconds / 60; 1388 Second := Hour_Seconds mod 60; 1389 1390 exception 1391 when Constraint_Error => 1392 raise Time_Error; 1393 end Split; 1394 1395 ------------- 1396 -- Time_Of -- 1397 ------------- 1398 1399 function Time_Of 1400 (Year : Year_Number; 1401 Month : Month_Number; 1402 Day : Day_Number; 1403 Day_Secs : Day_Duration; 1404 Hour : Integer; 1405 Minute : Integer; 1406 Second : Integer; 1407 Sub_Sec : Duration; 1408 Leap_Sec : Boolean; 1409 Use_Day_Secs : Boolean; 1410 Use_TZ : Boolean; 1411 Is_Historic : Boolean; 1412 Time_Zone : Long_Integer) return Time 1413 is 1414 Count : Integer; 1415 Elapsed_Leaps : Natural; 1416 Next_Leap_N : Time_Rep; 1417 Res_N : Time_Rep; 1418 Rounded_Res_N : Time_Rep; 1419 1420 begin 1421 -- Step 1: Check whether the day, month and year form a valid date 1422 1423 if Day > Days_In_Month (Month) 1424 and then (Day /= 29 or else Month /= 2 or else not Is_Leap (Year)) 1425 then 1426 raise Time_Error; 1427 end if; 1428 1429 -- Start accumulating nanoseconds from the low bound of Ada time 1430 1431 Res_N := Ada_Low; 1432 1433 -- Step 2: Year processing and centennial year adjustment. Determine 1434 -- the number of four year segments since the start of Ada time and 1435 -- the input date. 1436 1437 Count := (Year - Year_Number'First) / 4; 1438 1439 for Four_Year_Segments in 1 .. Count loop 1440 Res_N := Res_N + Nanos_In_Four_Years; 1441 end loop; 1442 1443 -- Note that non-leap centennial years are automatically considered 1444 -- leap in the operation above. An adjustment of several days is 1445 -- required to compensate for this. 1446 1447 if Year > 2300 then 1448 Res_N := Res_N - Time_Rep (3) * Nanos_In_Day; 1449 1450 elsif Year > 2200 then 1451 Res_N := Res_N - Time_Rep (2) * Nanos_In_Day; 1452 1453 elsif Year > 2100 then 1454 Res_N := Res_N - Time_Rep (1) * Nanos_In_Day; 1455 end if; 1456 1457 -- Add the remaining non-leap years 1458 1459 Count := (Year - Year_Number'First) mod 4; 1460 Res_N := Res_N + Time_Rep (Count) * Secs_In_Non_Leap_Year * Nano; 1461 1462 -- Step 3: Day of month processing. Determine the number of days 1463 -- since the start of the current year. Do not add the current 1464 -- day since it has not elapsed yet. 1465 1466 Count := Cumulative_Days_Before_Month (Month) + Day - 1; 1467 1468 -- The input year is leap and we have passed February 1469 1470 if Is_Leap (Year) 1471 and then Month > 2 1472 then 1473 Count := Count + 1; 1474 end if; 1475 1476 Res_N := Res_N + Time_Rep (Count) * Nanos_In_Day; 1477 1478 -- Step 4: Hour, minute, second and sub second processing 1479 1480 if Use_Day_Secs then 1481 Res_N := Res_N + Duration_To_Time_Rep (Day_Secs); 1482 1483 else 1484 Res_N := 1485 Res_N + Time_Rep (Hour * 3_600 + Minute * 60 + Second) * Nano; 1486 1487 if Sub_Sec = 1.0 then 1488 Res_N := Res_N + Time_Rep (1) * Nano; 1489 else 1490 Res_N := Res_N + Duration_To_Time_Rep (Sub_Sec); 1491 end if; 1492 end if; 1493 1494 -- At this point, the generated time value should be withing the 1495 -- bounds of Ada time. 1496 1497 Check_Within_Time_Bounds (Res_N); 1498 1499 -- Step 4: Time zone processing. At this point we have built an 1500 -- arbitrary time value which is not related to any time zone. 1501 -- For simplicity, the time value is normalized to GMT, producing 1502 -- a uniform representation which can be treated by arithmetic 1503 -- operations for instance without any additional corrections. 1504 1505 if Use_TZ then 1506 if Time_Zone /= 0 then 1507 Res_N := Res_N - Time_Rep (Time_Zone) * 60 * Nano; 1508 end if; 1509 1510 -- Ada 83 and 95 1511 1512 else 1513 declare 1514 Cur_Off : constant Long_Integer := 1515 UTC_Time_Offset (Time (Res_N), Is_Historic); 1516 Cur_Res_N : constant Time_Rep := 1517 Res_N - Time_Rep (Cur_Off) * Nano; 1518 Off : constant Long_Integer := 1519 UTC_Time_Offset (Time (Cur_Res_N), Is_Historic); 1520 1521 begin 1522 Res_N := Res_N - Time_Rep (Off) * Nano; 1523 end; 1524 end if; 1525 1526 -- Step 5: Leap seconds processing in GMT 1527 1528 if Leap_Support then 1529 Cumulative_Leap_Seconds 1530 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N); 1531 1532 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano; 1533 1534 -- An Ada 2005 caller requesting an explicit leap second or an 1535 -- Ada 95 caller accounting for an invisible leap second. 1536 1537 if Leap_Sec or else Res_N >= Next_Leap_N then 1538 Res_N := Res_N + Time_Rep (1) * Nano; 1539 end if; 1540 1541 -- Leap second validity check 1542 1543 Rounded_Res_N := Res_N - (Res_N mod Nano); 1544 1545 if Use_TZ 1546 and then Leap_Sec 1547 and then Rounded_Res_N /= Next_Leap_N 1548 then 1549 raise Time_Error; 1550 end if; 1551 end if; 1552 1553 return Time (Res_N); 1554 end Time_Of; 1555 1556 end Formatting_Operations; 1557 1558 --------------------------- 1559 -- Time_Zones_Operations -- 1560 --------------------------- 1561 1562 package body Time_Zones_Operations is 1563 1564 --------------------- 1565 -- UTC_Time_Offset -- 1566 --------------------- 1567 1568 function UTC_Time_Offset (Date : Time) return Long_Integer is 1569 begin 1570 return UTC_Time_Offset (Date, True); 1571 end UTC_Time_Offset; 1572 1573 end Time_Zones_Operations; 1574 1575-- Start of elaboration code for Ada.Calendar 1576 1577begin 1578 System.OS_Primitives.Initialize; 1579 1580end Ada.Calendar; 1581