a-calend-mingw.adb [plain text]
with System.OS_Primitives;
with System.OS_Interface;
package body Ada.Calendar is
use System.OS_Interface;
Ada_Year_Min : constant := 1901;
Ada_Year_Max : constant := 2099;
epoch_1970 : constant := 16#19D_B1DE_D53E_8000#; system_time_ns : constant := 100; Sec_Unit : constant := 10#1#E9;
function "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
begin
return (Left + Time (Right));
exception
when Constraint_Error =>
raise Time_Error;
end "+";
function "+" (Left : Duration; Right : Time) return Time is
pragma Unsuppress (Overflow_Check);
begin
return (Time (Left) + Right);
exception
when Constraint_Error =>
raise Time_Error;
end "+";
function "-" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
begin
return Left - Time (Right);
exception
when Constraint_Error =>
raise Time_Error;
end "-";
function "-" (Left : Time; Right : Time) return Duration is
pragma Unsuppress (Overflow_Check);
begin
return Duration (Left) - Duration (Right);
exception
when Constraint_Error =>
raise Time_Error;
end "-";
function "<" (Left, Right : Time) return Boolean is
begin
return Duration (Left) < Duration (Right);
end "<";
function "<=" (Left, Right : Time) return Boolean is
begin
return Duration (Left) <= Duration (Right);
end "<=";
function ">" (Left, Right : Time) return Boolean is
begin
return Duration (Left) > Duration (Right);
end ">";
function ">=" (Left, Right : Time) return Boolean is
begin
return Duration (Left) >= Duration (Right);
end ">=";
function Clock return Time is
begin
return Time (System.OS_Primitives.Clock);
end Clock;
function Day (Date : Time) return Day_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DD;
end Day;
function Month (Date : Time) return Month_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DM;
end Month;
function Seconds (Date : Time) return Day_Duration is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DS;
end Seconds;
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration)
is
Date_Int : aliased Long_Long_Integer;
Date_Loc : aliased Long_Long_Integer;
Timbuf : aliased SYSTEMTIME;
Int_Date : Long_Long_Integer;
Sub_Seconds : Duration;
begin
if Date < 0.0 then
Sub_Seconds := Duration (Date) -
Duration (Long_Long_Integer (Date + Duration'(0.5)));
Int_Date := Long_Long_Integer (Date - Sub_Seconds);
if Sub_Seconds < 0.0 then
Int_Date := Int_Date - 1;
Sub_Seconds := 1.0 + Sub_Seconds;
end if;
else
Sub_Seconds := Duration (Date) -
Duration (Long_Long_Integer (Date - Duration'(0.5)));
Int_Date := Long_Long_Integer (Date - Sub_Seconds);
end if;
Date_Int := Long_Long_Integer
(Int_Date * Sec_Unit / system_time_ns) + epoch_1970;
if not FileTimeToLocalFileTime (Date_Int'Access, Date_Loc'Access) then
raise Time_Error;
end if;
if not FileTimeToSystemTime (Date_Loc'Access, Timbuf'Access) then
raise Time_Error;
end if;
if Timbuf.wYear not in Ada_Year_Min .. Ada_Year_Max then
raise Time_Error;
end if;
Seconds :=
Duration (Timbuf.wHour) * 3_600.0 +
Duration (Timbuf.wMinute) * 60.0 +
Duration (Timbuf.wSecond) +
Sub_Seconds;
Day := Integer (Timbuf.wDay);
Month := Integer (Timbuf.wMonth);
Year := Integer (Timbuf.wYear);
end Split;
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0)
return Time
is
Timbuf : aliased SYSTEMTIME;
Now : aliased Long_Long_Integer;
Loc : aliased Long_Long_Integer;
Int_Secs : Integer;
Secs : Integer;
Add_One_Day : Boolean := False;
Date : Time;
begin
if not Year 'Valid
or else not Month 'Valid
or else not Day 'Valid
or else not Seconds'Valid
then
raise Constraint_Error;
end if;
if Seconds = 0.0 then
Int_Secs := 0;
else
Int_Secs := Integer (Seconds - 0.5);
end if;
if Int_Secs = 86_400 then
Secs := 0;
Add_One_Day := True;
else
Secs := Int_Secs;
end if;
Timbuf.wMilliseconds := 0;
Timbuf.wSecond := WORD (Secs mod 60);
Timbuf.wMinute := WORD ((Secs / 60) mod 60);
Timbuf.wHour := WORD (Secs / 3600);
Timbuf.wDay := WORD (Day);
Timbuf.wMonth := WORD (Month);
Timbuf.wYear := WORD (Year);
if not SystemTimeToFileTime (Timbuf'Access, Loc'Access) then
raise Time_Error;
end if;
if not LocalFileTimeToFileTime (Loc'Access, Now'Access) then
raise Time_Error;
end if;
declare
Sub_Sec : constant Duration := Seconds - Duration (Int_Secs);
begin
Date := Time ((Now - epoch_1970) * system_time_ns / Sec_Unit) +
Sub_Sec;
end;
if Add_One_Day then
Date := Date + Duration (86400.0);
end if;
return Date;
end Time_Of;
function Year (Date : Time) return Year_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DY;
end Year;
end Ada.Calendar;