File : a-calend.adb


   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-2015, 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 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  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 
  32 with Ada.Unchecked_Conversion;
  33 
  34 with Interfaces.C;
  35 
  36 with System.OS_Primitives;
  37 
  38 package body Ada.Calendar with
  39   SPARK_Mode => Off
  40 is
  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 behaviour 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 
1577 begin
1578    System.OS_Primitives.Initialize;
1579 
1580 end Ada.Calendar;