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