|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 11900 (0x2e7c)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─ ⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦4c85d69e2⟧
└─⟦this⟧
package body Calendar is
Ticks_Per_Day : constant Integer :=
Integer (Day_Duration'Last / Duration'(Duration'Delta));
subtype January is Integer range 0 .. 30;
subtype February is Integer range January'Last + 1 .. January'Last + 29;
subtype March is Integer range February'Last + 1 .. February'Last + 31;
subtype April is Integer range March'Last + 1 .. March'Last + 30;
subtype May is Integer range April'Last + 1 .. April'Last + 31;
subtype June is Integer range May'Last + 1 .. May'Last + 30;
subtype July is Integer range June'Last + 1 .. June'Last + 31;
subtype August is Integer range July'Last + 1 .. July'Last + 31;
subtype September is Integer range August'Last + 1 .. August'Last + 30;
subtype October is Integer range September'Last + 1 .. September'Last + 31;
subtype November is Integer range October'Last + 1 .. October'Last + 30;
subtype December is Integer range November'Last + 1 .. November'Last + 31;
Days_Per_Year : constant Integer range 365 .. 365 := December'Last;
Days_Per_Leap_Year : constant Integer := Days_Per_Year + 1;
Days_Per_Four_Years : constant Integer := (4 * Days_Per_Year) + 1;
Clock_Error : exception;
package Imports is
procedure Get_Political_Time (Seconds : out Integer;
Ticks : out Tick_Id;
Base_Year : out Year_Number);
--
-- Return time as a offset in seconds from the Base_Year and Ticks.
-- Base_Year is in the range 1901 .. 2099 and is = 1 mod 4.
pragma Suppress (Elaboration_Check, Get_Political_Time);
pragma Interface (Asm, Get_Political_Time);
pragma Import_Procedure (Get_Political_Time, "__GET_POLITICAL_TIME",
Mechanism => (Value, Value, Value));
end Imports;
function Clock return Time is
Seconds : Integer;
Ticks : Tick_Id;
Base_Year : Year_Number;
Base_Time : Time;
Day_Offset : Day_Id;
Seconds_Offset : Integer;
begin
Imports.Get_Political_Time (Seconds, Ticks, Base_Year);
Base_Time := Time_Of (Year => Base_Year,
Month => Month_Number'First,
Day => Day_Number'First);
Day_Offset := Seconds / (24 * 60 * 60);
Seconds_Offset := Seconds mod (24 * 60 * 60);
return (Days => Base_Time.Days + Day_Offset,
Seconds => Duration (Seconds_Offset) + Ticks);
exception
when others =>
raise Clock_Error;
end Clock;
procedure Split (Days : Day_Id;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number) is
Day_Temp : Integer := Integer (Days);
Year_Temp : Integer;
Is_Leap_Year : Boolean;
begin
Year_Temp := 4 * (Day_Temp / Days_Per_Four_Years);
Day_Temp := Day_Temp mod Days_Per_Four_Years;
Is_Leap_Year := Day_Temp >= (3 * Days_Per_Year);
if Day_Temp = Days_Per_Four_Years - 1 then
Year_Temp := Year_Temp + 3;
Day_Temp := Days_Per_Year;
else
Year_Temp := Year_Temp + (Day_Temp / Days_Per_Year);
Day_Temp := Day_Temp mod Days_Per_Year;
end if;
Year := Year_Number'First + Year_Temp;
if (not Is_Leap_Year) and then (Day_Temp >= February'Last) then
Day_Temp := Day_Temp + 1;
end if;
case Day_Temp is
when January =>
Month := 1;
Day := Day_Temp + 1 - January'First;
when February =>
Month := 2;
Day := Day_Temp + 1 - February'First;
when March =>
Month := 3;
Day := Day_Temp + 1 - March'First;
when April =>
Month := 4;
Day := Day_Temp + 1 - April'First;
when May =>
Month := 5;
Day := Day_Temp + 1 - May'First;
when June =>
Month := 6;
Day := Day_Temp + 1 - June'First;
when July =>
Month := 7;
Day := Day_Temp + 1 - July'First;
when August =>
Month := 8;
Day := Day_Temp + 1 - August'First;
when September =>
Month := 9;
Day := Day_Temp + 1 - September'First;
when October =>
Month := 10;
Day := Day_Temp + 1 - October'First;
when November =>
Month := 11;
Day := Day_Temp + 1 - November'First;
when December =>
Month := 12;
Day := Day_Temp + 1 - December'First;
when others =>
raise Program_Error;
end case;
end Split;
function Year (Date : Time) return Year_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
begin
Split (Date.Days, Year, Month, Day);
return Year;
end Year;
function Month (Date : Time) return Month_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
begin
Split (Date.Days, Year, Month, Day);
return Month;
end Month;
function Day (Date : Time) return Day_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
begin
Split (Date.Days, Year, Month, Day);
return Day;
end Day;
function Seconds (Date : Time) return Day_Duration is
begin
return Date.Seconds;
end Seconds;
procedure Split (Date : in Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration) is
begin
Seconds := Date.Seconds;
Split (Date.Days, Year, Month, Day);
end Split;
function Time_Of (Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0) return Time is
Result : Time;
Year_Temp : Integer;
Four_Years : Integer;
Day_Temp : Integer;
Is_Leap_Year : Boolean := ((Year mod 4) = 0);
-- NOTE: The year 2000 is a leap year even though it is a century
-- because it is also divisible by 400. Therefore, the test
-- for leap year is simplified for the range 1901 .. 2099
begin
Year_Temp := Year - Year_Number'First;
Four_Years := Year_Temp / 4;
Result.Days := Four_Years * Days_Per_Four_Years;
Year_Temp := Year_Temp - (Four_Years * 4);
Result.Days := Result.Days + (Year_Temp * Days_Per_Year);
case Month is
when 1 =>
Result.Days := Result.Days + January'First;
when 2 =>
if Day > (28 + Boolean'Pos (Is_Leap_Year)) then
raise Time_Error;
end if;
Result.Days := Result.Days + February'First;
when 3 =>
Result.Days := Result.Days + March'First -
Boolean'Pos (not Is_Leap_Year);
when 4 =>
if Day = Day_Number'Last then
raise Time_Error;
end if;
Result.Days := Result.Days + April'First -
Boolean'Pos (not Is_Leap_Year);
when 5 =>
Result.Days := Result.Days + May'First -
Boolean'Pos (not Is_Leap_Year);
when 6 =>
if Day = Day_Number'Last then
raise Time_Error;
end if;
Result.Days := Result.Days + June'First -
Boolean'Pos (not Is_Leap_Year);
when 7 =>
Result.Days := Result.Days + July'First -
Boolean'Pos (not Is_Leap_Year);
when 8 =>
Result.Days := Result.Days + August'First -
Boolean'Pos (not Is_Leap_Year);
when 9 =>
if Day = Day_Number'Last then
raise Time_Error;
end if;
Result.Days := Result.Days + September'First -
Boolean'Pos (not Is_Leap_Year);
when 10 =>
Result.Days := Result.Days + October'First -
Boolean'Pos (not Is_Leap_Year);
when 11 =>
if Day = Day_Number'Last then
raise Time_Error;
end if;
Result.Days := Result.Days + November'First -
Boolean'Pos (not Is_Leap_Year);
when 12 =>
Result.Days := Result.Days + December'First -
Boolean'Pos (not Is_Leap_Year);
end case;
Result.Days := Result.Days + Day - Day_Number'First;
if Seconds /= Day_Duration'Last then
Result.Seconds := Seconds;
else
Result.Seconds := 0.0;
if Result.Days = Day_Id'Last then
raise Time_Error;
end if;
Result.Days := Result.Days + 1;
end if;
return Result;
end Time_Of;
function "+" (Left : Time; Right : Duration) return Time is
Right_Ticks : Integer := Integer (Right / Duration'(Duration'Delta));
Right_Days : Integer := Right_Ticks / Ticks_Per_Day;
Right_Seconds : Duration :=
Duration ((Right_Ticks rem Ticks_Per_Day) * Duration'Delta);
Carry : Integer range -1 .. 1;
begin
if Right_Seconds + Left.Seconds in Tick_Id then
Carry := 0;
elsif Right > 0.0 then
Carry := 1;
else
Carry := -1;
end if;
return (Days => Day_Id (Integer (Left.Days) + Right_Days + Carry),
Seconds => Left.Seconds + Right_Seconds -
(Carry * Day_Duration'Last));
exception
when Constraint_Error | Numeric_Error =>
raise Time_Error;
end "+";
function "+" (Left : Duration; Right : Time) return Time is
begin
return "+" (Left => Right, Right => Left);
end "+";
function "-" (Left : Time; Right : Duration) return Time is
begin
return Left + (-Right);
exception
when Constraint_Error | Numeric_Error =>
raise Time_Error;
end "-";
function "-" (Left : Time; Right : Time) return Duration is
begin
return (Integer (Left.Days - Right.Days) * Day_Duration'Last) +
(Left.Seconds - Right.Seconds);
exception
when Constraint_Error | Numeric_Error =>
raise Time_Error;
end "-";
function "<" (Left, Right : Time) return Boolean is
begin
if Left.Days = Right.Days then
return Left.Seconds < Right.Seconds;
else
return Left.Days < Right.Days;
end if;
end "<";
function "<=" (Left, Right : Time) return Boolean is
begin
return (Left = Right) or else (Left < Right);
end "<=";
function ">" (Left, Right : Time) return Boolean is
begin
return (Left /= Right) and then not (Left < Right);
end ">";
function ">=" (Left, Right : Time) return Boolean is
begin
return not (Left < Right);
end ">=";
end Calendar;