a-calari$(objext) \
a-caldel$(objext) \
a-calend$(objext) \
+ a-calcon$(objext) \
a-calfor$(objext) \
a-catizo$(objext) \
a-cdlili$(objext) \
g-sttsne$(objext) \
g-table$(objext) \
g-tasloc$(objext) \
+ g-timsta$(objext) \
g-traceb$(objext) \
g-utf_32$(objext) \
g-u3spch$(objext) \
s-stopoo$(objext) \
s-stratt$(objext) \
s-strops$(objext) \
+ s-ststop$(objext) \
s-soflin$(objext) \
s-memory$(objext) \
s-memcop$(objext) \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . C A L E N D A R . C O N V E R S I O N S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2008, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Interfaces.C; use Interfaces.C;
+
+package body Ada.Calendar.Conversions is
+
+ -----------------
+ -- To_Ada_Time --
+ -----------------
+
+ function To_Ada_Time (Unix_Time : long) return Time is
+ Val : constant Long_Integer := Long_Integer (Unix_Time);
+ begin
+ return Conversion_Operations.To_Ada_Time (Val);
+ end To_Ada_Time;
+
+ -----------------
+ -- To_Ada_Time --
+ -----------------
+
+ function To_Ada_Time
+ (tm_year : int;
+ tm_mon : int;
+ tm_day : int;
+ tm_hour : int;
+ tm_min : int;
+ tm_sec : int;
+ tm_isdst : int) return Time
+ is
+ Year : constant Integer := Integer (tm_year);
+ Month : constant Integer := Integer (tm_mon);
+ Day : constant Integer := Integer (tm_day);
+ Hour : constant Integer := Integer (tm_hour);
+ Minute : constant Integer := Integer (tm_min);
+ Second : constant Integer := Integer (tm_sec);
+ DST : constant Integer := Integer (tm_isdst);
+ begin
+ return
+ Conversion_Operations.To_Ada_Time
+ (Year, Month, Day, Hour, Minute, Second, DST);
+ end To_Ada_Time;
+
+ -----------------
+ -- To_Duration --
+ -----------------
+
+ function To_Duration
+ (tv_sec : long;
+ tv_nsec : long) return Duration
+ is
+ Secs : constant Long_Integer := Long_Integer (tv_sec);
+ Nano_Secs : constant Long_Integer := Long_Integer (tv_nsec);
+ begin
+ return Conversion_Operations.To_Duration (Secs, Nano_Secs);
+ end To_Duration;
+
+ ------------------------
+ -- To_Struct_Timespec --
+ ------------------------
+
+ procedure To_Struct_Timespec
+ (D : Duration;
+ tv_sec : out long;
+ tv_nsec : out long)
+ is
+ Secs : Long_Integer;
+ Nano_Secs : Long_Integer;
+
+ begin
+ Conversion_Operations.To_Struct_Timespec (D, Secs, Nano_Secs);
+
+ tv_sec := long (Secs);
+ tv_nsec := long (Nano_Secs);
+ end To_Struct_Timespec;
+
+ ------------------
+ -- To_Struct_Tm --
+ ------------------
+
+ procedure To_Struct_Tm
+ (T : Time;
+ tm_year : out int;
+ tm_mon : out int;
+ tm_day : out int;
+ tm_hour : out int;
+ tm_min : out int;
+ tm_sec : out int)
+ is
+ Year : Integer;
+ Month : Integer;
+ Day : Integer;
+ Hour : Integer;
+ Minute : Integer;
+ Second : Integer;
+
+ begin
+ Conversion_Operations.To_Struct_Tm
+ (T, Year, Month, Day, Hour, Minute, Second);
+
+ tm_year := int (Year);
+ tm_mon := int (Month);
+ tm_day := int (Day);
+ tm_hour := int (Hour);
+ tm_min := int (Minute);
+ tm_sec := int (Second);
+ end To_Struct_Tm;
+
+ ------------------
+ -- To_Unix_Time --
+ ------------------
+
+ function To_Unix_Time (Ada_Time : Time) return long is
+ Val : constant Long_Integer :=
+ Conversion_Operations.To_Unix_Time (Ada_Time);
+ begin
+ return long (Val);
+ end To_Unix_Time;
+
+end Ada.Calendar.Conversions;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . C A L E N D A R . C O N V E R S I O N S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2008, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides various routines for conversion between Ada and Unix
+-- time models - Time, Duration, struct tm and struct timespec.
+
+with Interfaces.C;
+
+package Ada.Calendar.Conversions is
+
+ function To_Ada_Time (Unix_Time : Interfaces.C.long) return Time;
+ -- Convert a time value represented as number of seconds since the Unix
+ -- Epoch to a time value relative to an Ada implementation-defined Epoch.
+ -- The units of the result are 100 nanoseconds on VMS and nanoseconds on
+ -- all other targets. Raises Time_Error if the result cannot fit into a
+ -- Time value.
+
+ function To_Ada_Time
+ (tm_year : Interfaces.C.int;
+ tm_mon : Interfaces.C.int;
+ tm_day : Interfaces.C.int;
+ tm_hour : Interfaces.C.int;
+ tm_min : Interfaces.C.int;
+ tm_sec : Interfaces.C.int;
+ tm_isdst : Interfaces.C.int) return Time;
+ -- Convert a time value expressed in Unix-like fields of struct tm into
+ -- a Time value relative to the Ada Epoch. The ranges of the formals are
+ -- as follows:
+
+ -- tm_year -- years since 1900
+ -- tm_mon -- months since January [0 .. 11]
+ -- tm_day -- day of the month [1 .. 31]
+ -- tm_hour -- hours since midnight [0 .. 24]
+ -- tm_min -- minutes after the hour [0 .. 59]
+ -- tm_sec -- seconds after the minute [0 .. 60]
+ -- tm_isdst -- Daylight Savings Time flag [-1 .. 1]
+
+ -- The returned value is in UTC and may or may not contain leap seconds
+ -- depending on whether binder flag "-y" was used. Raises Time_Error if
+ -- the input values are out of the defined ranges or if tm_sec equals 60
+ -- and the instance in time is not a leap second occurence.
+
+ function To_Duration
+ (tv_sec : Interfaces.C.long;
+ tv_nsec : Interfaces.C.long) return Duration;
+ -- Convert an elapsed time value expressed in Unix-like fields of struct
+ -- timespec into a Duration value. The expected ranges are:
+
+ -- tv_sec - seconds
+ -- tv_nsec - nanoseconds
+
+ procedure To_Struct_Timespec
+ (D : Duration;
+ tv_sec : out Interfaces.C.long;
+ tv_nsec : out Interfaces.C.long);
+ -- Convert a Duration value into the constituents of struct timespec.
+ -- Formal tv_sec denotes seconds and tv_nsecs denotes nanoseconds.
+
+ procedure To_Struct_Tm
+ (T : Time;
+ tm_year : out Interfaces.C.int;
+ tm_mon : out Interfaces.C.int;
+ tm_day : out Interfaces.C.int;
+ tm_hour : out Interfaces.C.int;
+ tm_min : out Interfaces.C.int;
+ tm_sec : out Interfaces.C.int);
+ -- Convert a Time value set in the Ada Epoch into the constituents of
+ -- struct tm. The ranges of the out formals are as follows:
+
+ -- tm_year -- years since 1900
+ -- tm_mon -- months since January [0 .. 11]
+ -- tm_day -- day of the month [1 .. 31]
+ -- tm_hour -- hours since midnight [0 .. 24]
+ -- tm_min -- minutes after the hour [0 .. 59]
+ -- tm_sec -- seconds after the minute [0 .. 60]
+ -- tm_isdst -- Daylight Savings Time flag [-1 .. 1]
+
+ -- The input date is considered to be in UTC
+
+ function To_Unix_Time (Ada_Time : Time) return Interfaces.C.long;
+ -- Convert a time value represented as number of time units since the Ada
+ -- implementation-defined Epoch to a value relative to the Unix Epoch. The
+ -- units of the result are seconds. Raises Time_Error if the result cannot
+ -- fit into a Time value.
+
+end Ada.Calendar.Conversions;
-- target independent operation in Ada.Calendar is used to perform
-- this conversion.
- return Delays_Operations.To_Duration (T);
+ return Delay_Operations.To_Duration (T);
end To_Duration;
begin
-- Set up the Timed_Delay soft link to the non tasking version if it has
- -- not been already set.
-
- -- If tasking is present, Timed_Delay has already set this soft link, or
- -- this will be overridden during the elaboration of
+ -- not been already set. If tasking is present, Timed_Delay has already set
+ -- this soft link, or this will be overridden during the elaboration of
-- System.Tasking.Initialization
if SSL.Timed_Delay = null then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- This is the Alpha/VMS version
-with System.Aux_DEC; use System.Aux_DEC;
-
with Ada.Unchecked_Conversion;
+with System.Aux_DEC; use System.Aux_DEC;
+with System.OS_Primitives; use System.OS_Primitives;
+
package body Ada.Calendar is
--------------------------
-- Local Subprograms --
-----------------------
- procedure Check_Within_Time_Bounds (T : Time);
+ procedure Check_Within_Time_Bounds (T : OS_Time);
-- Ensure that a time representation value falls withing the bounds of Ada
-- time. Leap seconds support is taken into account.
procedure Cumulative_Leap_Seconds
- (Start_Date : Time;
- End_Date : Time;
+ (Start_Date : OS_Time;
+ End_Date : OS_Time;
Elapsed_Leaps : out Natural;
- Next_Leap_Sec : out Time);
+ Next_Leap_Sec : out OS_Time);
-- Elapsed_Leaps is the sum of the leap seconds that have occurred on or
-- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
-- represents the next leap second occurrence on or after End_Date. If
-- The range of Ada time expressed as milis since the VMS Epoch
- Ada_Low : constant Time := (10 * 366 + 32 * 365 + 45) * Milis_In_Day;
- Ada_High : constant Time := (131 * 366 + 410 * 365 + 45) * Milis_In_Day;
+ Ada_Low : constant OS_Time := (10 * 366 + 32 * 365 + 45) * Milis_In_Day;
+ Ada_High : constant OS_Time := (131 * 366 + 410 * 365 + 45) * Milis_In_Day;
-- Even though the upper bound of time is 2399-12-31 23:59:59.9999999
-- UTC, it must be increased to include all leap seconds.
- Ada_High_And_Leaps : constant Time :=
- Ada_High + Time (Leap_Seconds_Count) * Mili;
+ Ada_High_And_Leaps : constant OS_Time :=
+ Ada_High + OS_Time (Leap_Seconds_Count) * Mili;
-- Two constants used in the calculations of elapsed leap seconds.
-- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time
-- is earlier than Ada_Low in time zone +28.
- End_Of_Time : constant Time := Ada_High + Time (3) * Milis_In_Day;
- Start_Of_Time : constant Time := Ada_Low - Time (3) * Milis_In_Day;
+ End_Of_Time : constant OS_Time := Ada_High + OS_Time (3) * Milis_In_Day;
+ Start_Of_Time : constant OS_Time := Ada_Low - OS_Time (3) * Milis_In_Day;
-- The following table contains the hard time values of all existing leap
-- seconds. The values are produced by the utility program xleaps.adb.
- Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of Time :=
+ Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of OS_Time :=
(35855136000000000,
36014112010000000,
36329472020000000,
-- The bound of type Duration expressed as time
- Dur_High : constant Time := To_Relative_Time (Duration'Last);
- Dur_Low : constant Time := To_Relative_Time (Duration'First);
+ Dur_High : constant OS_Time :=
+ OS_Time (To_Relative_Time (Duration'Last));
+ Dur_Low : constant OS_Time :=
+ OS_Time (To_Relative_Time (Duration'First));
- Res_M : Time;
+ Res_M : OS_Time;
begin
- Res_M := Left - Right;
+ Res_M := OS_Time (Left) - OS_Time (Right);
-- Due to the extended range of Ada time, "-" is capable of producing
-- results which may exceed the range of Duration. In order to prevent
-- Normal case, result fits
else
- return To_Duration (Res_M);
+ return To_Duration (Time (Res_M));
end if;
exception
function "<" (Left, Right : Time) return Boolean is
begin
- return Long_Integer (Left) < Long_Integer (Right);
+ return OS_Time (Left) < OS_Time (Right);
end "<";
----------
function "<=" (Left, Right : Time) return Boolean is
begin
- return Long_Integer (Left) <= Long_Integer (Right);
+ return OS_Time (Left) <= OS_Time (Right);
end "<=";
---------
function ">" (Left, Right : Time) return Boolean is
begin
- return Long_Integer (Left) > Long_Integer (Right);
+ return OS_Time (Left) > OS_Time (Right);
end ">";
----------
function ">=" (Left, Right : Time) return Boolean is
begin
- return Long_Integer (Left) >= Long_Integer (Right);
+ return OS_Time (Left) >= OS_Time (Right);
end ">=";
------------------------------
-- Check_Within_Time_Bounds --
------------------------------
- procedure Check_Within_Time_Bounds (T : Time) is
+ procedure Check_Within_Time_Bounds (T : OS_Time) is
begin
if Leap_Support then
if T < Ada_Low or else T > Ada_High_And_Leaps then
function Clock return Time is
Elapsed_Leaps : Natural;
- Next_Leap_M : Time;
- Res_M : constant Time := Time (OSP.OS_Clock);
+ Next_Leap_M : OS_Time;
+ Res_M : constant OS_Time := OS_Clock;
begin
-- Note that on other targets a soft-link is used to get a different
Elapsed_Leaps := 0;
end if;
- return Res_M + Time (Elapsed_Leaps) * Mili;
+ return Time (Res_M + OS_Time (Elapsed_Leaps) * Mili);
end Clock;
-----------------------------
-----------------------------
procedure Cumulative_Leap_Seconds
- (Start_Date : Time;
- End_Date : Time;
+ (Start_Date : OS_Time;
+ End_Date : OS_Time;
Elapsed_Leaps : out Natural;
- Next_Leap_Sec : out Time)
+ Next_Leap_Sec : out OS_Time)
is
End_Index : Positive;
- End_T : Time := End_Date;
+ End_T : OS_Time := End_Date;
Start_Index : Positive;
- Start_T : Time := Start_Date;
+ Start_T : OS_Time := Start_Date;
begin
pragma Assert (Leap_Support and then End_Date >= Start_Date);
function Add (Date : Time; Days : Long_Integer) return Time is
pragma Unsuppress (Overflow_Check);
+ Date_M : constant OS_Time := OS_Time (Date);
begin
- return Date + Time (Days) * Milis_In_Day;
+ return Time (Date_M + OS_Time (Days) * Milis_In_Day);
exception
when Constraint_Error =>
raise Time_Error;
Seconds : out Duration;
Leap_Seconds : out Integer)
is
- Mili_F : constant Duration := 10_000_000.0;
-
- Diff_M : Time;
- Diff_S : Time;
- Earlier : Time;
+ Diff_M : OS_Time;
+ Diff_S : OS_Time;
+ Earlier : OS_Time;
Elapsed_Leaps : Natural;
- Later : Time;
+ Later : OS_Time;
Negate : Boolean := False;
- Next_Leap : Time;
+ Next_Leap : OS_Time;
Sub_Seconds : Duration;
begin
-- being raised by the arithmetic operators in Ada.Calendar.
if Left >= Right then
- Later := Left;
- Earlier := Right;
+ Later := OS_Time (Left);
+ Earlier := OS_Time (Right);
else
- Later := Right;
- Earlier := Left;
+ Later := OS_Time (Right);
+ Earlier := OS_Time (Left);
Negate := True;
end if;
Elapsed_Leaps := 0;
end if;
- Diff_M := Later - Earlier - Time (Elapsed_Leaps) * Mili;
+ Diff_M := Later - Earlier - OS_Time (Elapsed_Leaps) * Mili;
-- Sub second processing
function Subtract (Date : Time; Days : Long_Integer) return Time is
pragma Unsuppress (Overflow_Check);
+ Date_M : constant OS_Time := OS_Time (Date);
begin
- return Date - Time (Days) * Milis_In_Day;
+ return Time (Date_M - OS_Time (Days) * Milis_In_Day);
exception
when Constraint_Error =>
raise Time_Error;
end Subtract;
end Arithmetic_Operations;
+ ---------------------------
+ -- Conversion_Operations --
+ ---------------------------
+
+ package body Conversion_Operations is
+
+ Epoch_Offset : constant OS_Time := 35067168000000000;
+ -- The difference between 1970-1-1 UTC and 1858-11-17 UTC expressed in
+ -- 100 nanoseconds.
+
+ -----------------
+ -- To_Ada_Time --
+ -----------------
+
+ function To_Ada_Time (Unix_Time : Long_Integer) return Time is
+ pragma Unsuppress (Overflow_Check);
+ Unix_Rep : constant OS_Time := OS_Time (Unix_Time) * Mili;
+ begin
+ return Time (Unix_Rep + Epoch_Offset);
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end To_Ada_Time;
+
+ -----------------
+ -- To_Ada_Time --
+ -----------------
+
+ function To_Ada_Time
+ (tm_year : Integer;
+ tm_mon : Integer;
+ tm_day : Integer;
+ tm_hour : Integer;
+ tm_min : Integer;
+ tm_sec : Integer;
+ tm_isdst : Integer) return Time
+ is
+ pragma Unsuppress (Overflow_Check);
+
+ Year_Shift : constant Integer := 1900;
+ Month_Shift : constant Integer := 1;
+
+ Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Second : Integer;
+ Leap : Boolean;
+ Result : OS_Time;
+
+ begin
+ -- Input processing
+
+ Year := Year_Number (Year_Shift + tm_year);
+ Month := Month_Number (Month_Shift + tm_mon);
+ Day := Day_Number (tm_day);
+
+ -- Step 1: Validity checks of input values
+
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else tm_hour not in 0 .. 24
+ or else tm_min not in 0 .. 59
+ or else tm_sec not in 0 .. 60
+ or else tm_isdst not in -1 .. 1
+ then
+ raise Time_Error;
+ end if;
+
+ -- Step 2: Potential leap second
+
+ if tm_sec = 60 then
+ Leap := True;
+ Second := 59;
+ else
+ Leap := False;
+ Second := tm_sec;
+ end if;
+
+ -- Step 3: Calculate the time value
+
+ Result :=
+ OS_Time
+ (Formatting_Operations.Time_Of
+ (Year => Year,
+ Month => Month,
+ Day => Day,
+ Day_Secs => 0.0, -- Time is given in h:m:s
+ Hour => tm_hour,
+ Minute => tm_min,
+ Second => Second,
+ Sub_Sec => 0.0, -- No precise sub second given
+ Leap_Sec => Leap,
+ Use_Day_Secs => False, -- Time is given in h:m:s
+ Is_Ada_05 => True, -- Force usage of explicit time zone
+ Time_Zone => 0)); -- Place the value in UTC
+ -- Step 4: Daylight Savings Time
+
+ if tm_isdst = 1 then
+ Result := Result + OS_Time (3_600) * Mili;
+ end if;
+
+ return Time (Result);
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end To_Ada_Time;
+
+ -----------------
+ -- To_Duration --
+ -----------------
+
+ function To_Duration
+ (tv_sec : Long_Integer;
+ tv_nsec : Long_Integer) return Duration
+ is
+ pragma Unsuppress (Overflow_Check);
+ begin
+ return Duration (tv_sec) + Duration (tv_nsec) / Mili_F;
+ end To_Duration;
+
+ ------------------------
+ -- To_Struct_Timespec --
+ ------------------------
+
+ procedure To_Struct_Timespec
+ (D : Duration;
+ tv_sec : out Long_Integer;
+ tv_nsec : out Long_Integer)
+ is
+ pragma Unsuppress (Overflow_Check);
+ Secs : Duration;
+ Nano_Secs : Duration;
+
+ begin
+ -- Seconds extraction, avoid potential rounding errors
+
+ Secs := D - 0.5;
+ tv_sec := Long_Integer (Secs);
+
+ -- 100 Nanoseconds extraction
+
+ Nano_Secs := D - Duration (tv_sec);
+ tv_nsec := Long_Integer (Nano_Secs * Mili);
+ end To_Struct_Timespec;
+
+ ------------------
+ -- To_Struct_Tm --
+ ------------------
+
+ procedure To_Struct_Tm
+ (T : Time;
+ tm_year : out Integer;
+ tm_mon : out Integer;
+ tm_day : out Integer;
+ tm_hour : out Integer;
+ tm_min : out Integer;
+ tm_sec : out Integer)
+ is
+ pragma Unsuppress (Overflow_Check);
+ Year : Year_Number;
+ Month : Month_Number;
+ Second : Integer;
+ Day_Secs : Day_Duration;
+ Sub_Sec : Duration;
+ Leap_Sec : Boolean;
+
+ begin
+ -- Step 1: Split the input time
+
+ Formatting_Operations.Split
+ (T, Year, Month, tm_day, Day_Secs,
+ tm_hour, tm_min, Second, Sub_Sec, Leap_Sec, True, 0);
+
+ -- Step 2: Correct the year and month
+
+ tm_year := Year - 1900;
+ tm_mon := Month - 1;
+
+ -- Step 3: Handle leap second occurences
+
+ if Leap_Sec then
+ tm_sec := 60;
+ else
+ tm_sec := Second;
+ end if;
+ end To_Struct_Tm;
+
+ ------------------
+ -- To_Unix_Time --
+ ------------------
+
+ function To_Unix_Time (Ada_Time : Time) return Long_Integer is
+ pragma Unsuppress (Overflow_Check);
+ Ada_OS_Time : constant OS_Time := OS_Time (Ada_Time);
+ begin
+ return Long_Integer ((Ada_OS_Time - Epoch_Offset) / Mili);
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end To_Unix_Time;
+ end Conversion_Operations;
+
---------------------------
-- Formatting_Operations --
---------------------------
Ada_Min_Year : constant := 1901;
Ada_Max_Year : constant := 2399;
- Mili_F : constant Duration := 10_000_000.0;
- Date_M : Time;
+ Date_M : OS_Time;
Elapsed_Leaps : Natural;
- Next_Leap_M : Time;
+ Next_Leap_M : OS_Time;
begin
- Date_M := Date;
+ Date_M := OS_Time (Date);
-- Step 1: Leap seconds processing
if Leap_Support then
Cumulative_Leap_Seconds
- (Start_Of_Time, Date, Elapsed_Leaps, Next_Leap_M);
+ (Start_Of_Time, Date_M, Elapsed_Leaps, Next_Leap_M);
Leap_Sec := Date_M >= Next_Leap_M;
Leap_Sec := False;
end if;
- Date_M := Date_M - Time (Elapsed_Leaps) * Mili;
+ Date_M := Date_M - OS_Time (Elapsed_Leaps) * Mili;
-- Step 2: Time zone processing
if Time_Zone /= 0 then
- Date_M := Date_M + Time (Time_Zone) * 60 * Mili;
+ Date_M := Date_M + OS_Time (Time_Zone) * 60 * Mili;
end if;
-- After the leap seconds and time zone have been accounted for,
-- Step 4: VMS system call
- Numtim (Status, Timbuf, Date_M);
+ Numtim (Status, Timbuf, Time (Date_M));
if Status mod 2 /= 1
or else Timbuf (1) not in Ada_Min_Year .. Ada_Max_Year
Minute : Integer;
Second : Integer;
Sub_Sec : Duration;
- Leap_Sec : Boolean;
- Use_Day_Secs : Boolean;
- Is_Ada_05 : Boolean;
- Time_Zone : Long_Integer) return Time
+ Leap_Sec : Boolean := False;
+ Use_Day_Secs : Boolean := False;
+ Is_Ada_05 : Boolean := False;
+ Time_Zone : Long_Integer := 0) return Time
is
procedure Cvt_Vectim
(Status : out Unsigned_Longword;
Status : Unsigned_Longword;
Timbuf : Unsigned_Word_Array (1 .. 7);
- Mili_F : constant := 10_000_000.0;
-
Y : Year_Number := Year;
Mo : Month_Number := Month;
D : Day_Number := Day;
Elapsed_Leaps : Natural;
Int_Day_Secs : Integer;
- Next_Leap_M : Time;
- Res_M : Time;
- Rounded_Res_M : Time;
+ Next_Leap_M : OS_Time;
+ Res : Time;
+ Res_M : OS_Time;
+ Rounded_Res_M : OS_Time;
begin
-- No validity checks are performed on the input values since it is
Timbuf (6) := Unsigned_Word (Se);
Timbuf (7) := 0;
- Cvt_Vectim (Status, Timbuf, Res_M);
+ Cvt_Vectim (Status, Timbuf, Res);
if Status mod 2 /= 1 then
raise Time_Error;
-- Step 3: Sub second adjustment
- Res_M := Res_M + Time (Su * Mili_F);
+ Res_M := OS_Time (Res) + OS_Time (Su * Mili_F);
-- Step 4: Bounds check
-- Step 5: Time zone processing
if Time_Zone /= 0 then
- Res_M := Res_M - Time (Time_Zone) * 60 * Mili;
+ Res_M := Res_M - OS_Time (Time_Zone) * 60 * Mili;
end if;
-- Step 6: Leap seconds processing
Cumulative_Leap_Seconds
(Start_Of_Time, Res_M, Elapsed_Leaps, Next_Leap_M);
- Res_M := Res_M + Time (Elapsed_Leaps) * Mili;
+ Res_M := Res_M + OS_Time (Elapsed_Leaps) * Mili;
-- An Ada 2005 caller requesting an explicit leap second or an
-- Ada 95 caller accounting for an invisible leap second.
if Leap_Sec
or else Res_M >= Next_Leap_M
then
- Res_M := Res_M + Time (1) * Mili;
+ Res_M := Res_M + OS_Time (1) * Mili;
end if;
-- Leap second validity check
end if;
end if;
- return Res_M;
+ return Time (Res_M);
end Time_Of;
end Formatting_Operations;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- readability, this unit will be called "mili".
Mili : constant := 10_000_000;
+ Mili_F : constant := 10_000_000.0;
Milis_In_Day : constant := 864_000_000_000;
Secs_In_Day : constant := 86_400;
-- NOTE: Delays does not need a target independent interface because
-- VMS already has a target specific file for that package.
+ ---------------------------
+ -- Arithmetic_Operations --
+ ---------------------------
+
package Arithmetic_Operations is
+
function Add (Date : Time; Days : Long_Integer) return Time;
-- Add a certain number of days to a time value
function Subtract (Date : Time; Days : Long_Integer) return Time;
-- Subtract a certain number of days from a time value
+
end Arithmetic_Operations;
+ ---------------------------
+ -- Conversion_Operations --
+ ---------------------------
+
+ package Conversion_Operations is
+ function To_Ada_Time (Unix_Time : Long_Integer) return Time;
+ -- Unix to Ada Epoch conversion
+
+ function To_Ada_Time
+ (tm_year : Integer;
+ tm_mon : Integer;
+ tm_day : Integer;
+ tm_hour : Integer;
+ tm_min : Integer;
+ tm_sec : Integer;
+ tm_isdst : Integer) return Time;
+ -- Struct tm to Ada Epoch conversion
+
+ function To_Duration
+ (tv_sec : Long_Integer;
+ tv_nsec : Long_Integer) return Duration;
+ -- Struct timespec to Duration conversion
+
+ procedure To_Struct_Timespec
+ (D : Duration;
+ tv_sec : out Long_Integer;
+ tv_nsec : out Long_Integer);
+ -- Duration to struct timespec conversion
+
+ procedure To_Struct_Tm
+ (T : Time;
+ tm_year : out Integer;
+ tm_mon : out Integer;
+ tm_day : out Integer;
+ tm_hour : out Integer;
+ tm_min : out Integer;
+ tm_sec : out Integer);
+ -- Time to struct tm conversion
+
+ function To_Unix_Time (Ada_Time : Time) return Long_Integer;
+ -- Ada to Unix Epoch conversion
+
+ end Conversion_Operations;
+
+ ---------------------------
+ -- Formatting_Operations --
+ ---------------------------
+
package Formatting_Operations is
+
function Day_Of_Week (Date : Time) return Integer;
-- Determine which day of week Date falls on. The returned values are
-- within the range of 0 .. 6 (Monday .. Sunday).
Minute : Integer;
Second : Integer;
Sub_Sec : Duration;
- Leap_Sec : Boolean;
- Use_Day_Secs : Boolean;
- Is_Ada_05 : Boolean;
- Time_Zone : Long_Integer) return Time;
+ Leap_Sec : Boolean := False;
+ Use_Day_Secs : Boolean := False;
+ Is_Ada_05 : Boolean := False;
+ Time_Zone : Long_Integer := 0) return Time;
-- Given all the components of a date, return the corresponding time
-- value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the
-- day duration will be calculated from Hour, Minute, Second and Sub_
-- Sec. Set Is_Ada_05 to use the local time zone (the value in formal
-- Time_Zone is ignored) when building a time value and to verify the
-- validity of a requested leap second.
+
end Formatting_Operations;
+ ---------------------------
+ -- Time_Zones_Operations --
+ ---------------------------
+
package Time_Zones_Operations is
+
function UTC_Time_Offset (Date : Time) return Long_Integer;
-- Return the offset in seconds from UTC
+
end Time_Zones_Operations;
end Ada.Calendar;
when Constraint_Error =>
raise Time_Error;
end Subtract;
+
end Arithmetic_Operations;
+ ---------------------------
+ -- Conversion_Operations --
+ ---------------------------
+
+ package body Conversion_Operations is
+
+ Epoch_Offset : constant Time_Rep :=
+ (136 * 365 + 44 * 366) * Nanos_In_Day;
+ -- The difference between 2150-1-1 UTC and 1970-1-1 UTC expressed in
+ -- nanoseconds. Note that year 2100 is non-leap.
+
+ -----------------
+ -- To_Ada_Time --
+ -----------------
+
+ function To_Ada_Time (Unix_Time : Long_Integer) return Time is
+ pragma Unsuppress (Overflow_Check);
+ Unix_Rep : constant Time_Rep := Time_Rep (Unix_Time) * Nano;
+ begin
+ return Time (Unix_Rep - Epoch_Offset);
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end To_Ada_Time;
+
+ -----------------
+ -- To_Ada_Time --
+ -----------------
+
+ function To_Ada_Time
+ (tm_year : Integer;
+ tm_mon : Integer;
+ tm_day : Integer;
+ tm_hour : Integer;
+ tm_min : Integer;
+ tm_sec : Integer;
+ tm_isdst : Integer) return Time
+ is
+ pragma Unsuppress (Overflow_Check);
+ Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Second : Integer;
+ Leap : Boolean;
+ Result : Time_Rep;
+
+ begin
+ -- Input processing
+
+ Year := Year_Number (1900 + tm_year);
+ Month := Month_Number (1 + tm_mon);
+ Day := Day_Number (tm_day);
+
+ -- Step 1: Validity checks of input values
+
+ if not Year'Valid
+ or else not Month'Valid
+ or else not Day'Valid
+ or else tm_hour not in 0 .. 24
+ or else tm_min not in 0 .. 59
+ or else tm_sec not in 0 .. 60
+ or else tm_isdst not in -1 .. 1
+ then
+ raise Time_Error;
+ end if;
+
+ -- Step 2: Potential leap second
+
+ if tm_sec = 60 then
+ Leap := True;
+ Second := 59;
+ else
+ Leap := False;
+ Second := tm_sec;
+ end if;
+
+ -- Step 3: Calculate the time value
+
+ Result :=
+ Time_Rep
+ (Formatting_Operations.Time_Of
+ (Year => Year,
+ Month => Month,
+ Day => Day,
+ Day_Secs => 0.0, -- Time is given in h:m:s
+ Hour => tm_hour,
+ Minute => tm_min,
+ Second => Second,
+ Sub_Sec => 0.0, -- No precise sub second given
+ Leap_Sec => Leap,
+ Use_Day_Secs => False, -- Time is given in h:m:s
+ Is_Ada_05 => True, -- Force usage of explicit time zone
+ Time_Zone => 0)); -- Place the value in UTC
+
+ -- Step 4: Daylight Savings Time
+
+ if tm_isdst = 1 then
+ Result := Result + Time_Rep (3_600) * Nano;
+ end if;
+
+ return Time (Result);
+
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end To_Ada_Time;
+
+ -----------------
+ -- To_Duration --
+ -----------------
+
+ function To_Duration
+ (tv_sec : Long_Integer;
+ tv_nsec : Long_Integer) return Duration
+ is
+ pragma Unsuppress (Overflow_Check);
+ begin
+ return Duration (tv_sec) + Duration (tv_nsec) / Nano_F;
+ end To_Duration;
+
+ ------------------------
+ -- To_Struct_Timespec --
+ ------------------------
+
+ procedure To_Struct_Timespec
+ (D : Duration;
+ tv_sec : out Long_Integer;
+ tv_nsec : out Long_Integer)
+ is
+ pragma Unsuppress (Overflow_Check);
+ Secs : Duration;
+ Nano_Secs : Duration;
+
+ begin
+ -- Seconds extraction, avoid potential rounding errors
+
+ Secs := D - 0.5;
+ tv_sec := Long_Integer (Secs);
+
+ -- Nanoseconds extraction
+
+ Nano_Secs := D - Duration (tv_sec);
+ tv_nsec := Long_Integer (Nano_Secs * Nano);
+ end To_Struct_Timespec;
+
+ ------------------
+ -- To_Struct_Tm --
+ ------------------
+
+ procedure To_Struct_Tm
+ (T : Time;
+ tm_year : out Integer;
+ tm_mon : out Integer;
+ tm_day : out Integer;
+ tm_hour : out Integer;
+ tm_min : out Integer;
+ tm_sec : out Integer)
+ is
+ pragma Unsuppress (Overflow_Check);
+ Year : Year_Number;
+ Month : Month_Number;
+ Second : Integer;
+ Day_Secs : Day_Duration;
+ Sub_Sec : Duration;
+ Leap_Sec : Boolean;
+
+ begin
+ -- Step 1: Split the input time
+
+ Formatting_Operations.Split
+ (T, Year, Month, tm_day, Day_Secs,
+ tm_hour, tm_min, Second, Sub_Sec, Leap_Sec, True, 0);
+
+ -- Step 2: Correct the year and month
+
+ tm_year := Year - 1900;
+ tm_mon := Month - 1;
+
+ -- Step 3: Handle leap second occurences
+
+ if Leap_Sec then
+ tm_sec := 60;
+ else
+ tm_sec := Second;
+ end if;
+ end To_Struct_Tm;
+
+ ------------------
+ -- To_Unix_Time --
+ ------------------
+
+ function To_Unix_Time (Ada_Time : Time) return Long_Integer is
+ pragma Unsuppress (Overflow_Check);
+ Ada_Rep : constant Time_Rep := Time_Rep (Ada_Time);
+ begin
+ return Long_Integer ((Ada_Rep + Epoch_Offset) / Nano);
+ exception
+ when Constraint_Error =>
+ raise Time_Error;
+ end To_Unix_Time;
+ end Conversion_Operations;
+
----------------------
-- Delay_Operations --
----------------------
- package body Delays_Operations is
+ package body Delay_Operations is
-----------------
-- To_Duration --
return Time (Res_N) - Time (Unix_Min);
end To_Duration;
- end Delays_Operations;
+
+ end Delay_Operations;
---------------------------
-- Formatting_Operations --
Minute : Integer;
Second : Integer;
Sub_Sec : Duration;
- Leap_Sec : Boolean;
- Use_Day_Secs : Boolean;
- Is_Ada_05 : Boolean;
- Time_Zone : Long_Integer) return Time
+ Leap_Sec : Boolean := False;
+ Use_Day_Secs : Boolean := False;
+ Is_Ada_05 : Boolean := False;
+ Time_Zone : Long_Integer := 0) return Time
is
Count : Integer;
Elapsed_Leaps : Natural;
return Time (Res_N);
end Time_Of;
+
end Formatting_Operations;
---------------------------
return Offset;
end UTC_Time_Offset;
+
end Time_Zones_Operations;
-- Start of elaboration code for Ada.Calendar
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- Determine whether a given year is leap
-- The following packages provide a target independent interface to the
- -- children of Calendar - Arithmetic, Delays, Formatting and Time_Zones.
+ -- children of Calendar - Arithmetic, Conversions, Delays, Formatting and
+ -- Time_Zones.
+
+ ---------------------------
+ -- Arithmetic_Operations --
+ ---------------------------
package Arithmetic_Operations is
+
function Add (Date : Time; Days : Long_Integer) return Time;
-- Add a certain number of days to a time value
function Subtract (Date : Time; Days : Long_Integer) return Time;
-- Subtract a certain number of days from a time value
+
end Arithmetic_Operations;
- package Delays_Operations is
+ ---------------------------
+ -- Conversion_Operations --
+ ---------------------------
+
+ package Conversion_Operations is
+
+ function To_Ada_Time (Unix_Time : Long_Integer) return Time;
+ -- Unix to Ada Epoch conversion
+
+ function To_Ada_Time
+ (tm_year : Integer;
+ tm_mon : Integer;
+ tm_day : Integer;
+ tm_hour : Integer;
+ tm_min : Integer;
+ tm_sec : Integer;
+ tm_isdst : Integer) return Time;
+ -- Struct tm to Ada Epoch conversion
+
+ function To_Duration
+ (tv_sec : Long_Integer;
+ tv_nsec : Long_Integer) return Duration;
+ -- Struct timespec to Duration conversion
+
+ procedure To_Struct_Timespec
+ (D : Duration;
+ tv_sec : out Long_Integer;
+ tv_nsec : out Long_Integer);
+ -- Duration to struct timespec conversion
+
+ procedure To_Struct_Tm
+ (T : Time;
+ tm_year : out Integer;
+ tm_mon : out Integer;
+ tm_day : out Integer;
+ tm_hour : out Integer;
+ tm_min : out Integer;
+ tm_sec : out Integer);
+ -- Time to struct tm conversion
+
+ function To_Unix_Time (Ada_Time : Time) return Long_Integer;
+ -- Ada to Unix Epoch conversion
+
+ end Conversion_Operations;
+
+ ----------------------
+ -- Delay_Operations --
+ ----------------------
+
+ package Delay_Operations is
+
function To_Duration (Date : Time) return Duration;
-- Given a time value in nanoseconds since 1901, convert it into a
-- duration value giving the number of nanoseconds since the Unix Epoch.
- end Delays_Operations;
+
+ end Delay_Operations;
+
+ ---------------------------
+ -- Formatting_Operations --
+ ---------------------------
package Formatting_Operations is
+
function Day_Of_Week (Date : Time) return Integer;
-- Determine which day of week Date falls on. The returned values are
-- within the range of 0 .. 6 (Monday .. Sunday).
Minute : Integer;
Second : Integer;
Sub_Sec : Duration;
- Leap_Sec : Boolean;
- Use_Day_Secs : Boolean;
- Is_Ada_05 : Boolean;
- Time_Zone : Long_Integer) return Time;
+ Leap_Sec : Boolean := False;
+ Use_Day_Secs : Boolean := False;
+ Is_Ada_05 : Boolean := False;
+ Time_Zone : Long_Integer := 0) return Time;
-- Given all the components of a date, return the corresponding time
-- value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the
-- day duration will be calculated from Hour, Minute, Second and Sub_
-- Sec. Set Is_Ada_05 to use the local time zone (the value in formal
-- Time_Zone is ignored) when building a time value and to verify the
-- validity of a requested leap second.
+
end Formatting_Operations;
+ ---------------------------
+ -- Time_Zones_Operations --
+ ---------------------------
+
package Time_Zones_Operations is
+
function UTC_Time_Offset (Date : Time) return Long_Integer;
-- Return the offset in seconds from UTC
+
end Time_Zones_Operations;
end Ada.Calendar;
projects / gcc.git / commitdiff