|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Calendar, package body Local_Time, seg_04cdd8
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with System;
with V_I_Time;
package body Calendar is
type Time_Float is digits 9;
package Local_Time is
function Clock return Time;
Seconds_From_Gmt : Time_Float;
function Daylight_Savings
(Year, Julian_Day : Integer) return Time_Float;
end Local_Time;
Seconds_Per_Day : constant := 86400.0;
function Is_Leap_Year (Year : Year_Number) return Boolean is
begin
return Year mod 4 = 0;
end Is_Leap_Year;
function Days_In_Month (Month : Month_Number; Of_Year : Year_Number)
return Day_Number is
begin
case Month is
when 1 | 3 | 5 | 7 .. 8 | 10 | 12 =>
return 31;
when 2 =>
if Is_Leap_Year (Of_Year) then
return 29;
else
return 28;
end if;
when others =>
return 30;
end case;
end Days_In_Month;
function Clock return Time is
begin
return Local_Time.Clock;
end Clock;
function Year (Date : Time) return Year_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration;
begin
Split (Date, Year, Month, Day, Seconds);
return Year;
end Year;
function Month (Date : Time) return Month_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration;
begin
Split (Date, Year, Month, Day, Seconds);
return Month;
end Month;
function Day (Date : Time) return Day_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration;
begin
Split (Date, Year, Month, Day, Seconds);
return Day;
end Day;
function Seconds (Date : Time) return Day_Duration is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration;
begin
Split (Date, Year, Month, Day, Seconds);
return Seconds;
end Seconds;
function Julian_Day_Of
(Year : Year_Number; Month : Month_Number; Day : Day_Number)
return Integer is
J, M, Y, C, Ya : Integer;
begin
if Month > 2 then
M := Month - 3;
Y := Year;
else
M := Month + 9;
Y := Year - 1;
end if;
C := Y / 100;
Ya := Y - 100 * C;
return (146097 * C) / 4 + (1461 * Ya) / 4 +
(153 * M + 2) / 5 + Day + 1721119;
end Julian_Day_Of;
procedure Date_From_Julian_Day (Jday : Integer;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number) is
J : Integer := Jday - 1721119;
Y : Integer := (4 * J - 1) / 146097;
D, M : Integer;
begin
J := 4 * J - 1 - 146097 * Y;
D := J / 4;
J := (4 * D + 3) / 1461;
D := 4 * D + 3 - 1461 * J;
D := (D + 4) / 4;
M := (5 * D - 3) / 153;
D := 5 * D - 3 - 153 * M;
Day := (D + 5) / 5;
Y := 100 * Y + J;
if M < 10 then
Month := M + 3;
Year := Y;
else
Month := M - 9;
Year := Y + 1;
end if;
end Date_From_Julian_Day;
procedure Split (Date : in Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration) is
S : Time_Float := Time_Float (Date.Sec);
Jday : Integer := Date.Julian_Day;
Y : Integer;
begin
S := Time_Float (Date.Sec) - Local_Time.Seconds_From_Gmt;
if S < 0.0 then
Jday := Jday - 1;
S := S + Seconds_Per_Day;
end if;
Date_From_Julian_Day (Jday, Y, Month, Day);
S := S + Local_Time.Daylight_Savings (Y, Jday);
if S >= Seconds_Per_Day then
Jday := Jday + 1;
S := S - Seconds_Per_Day;
Date_From_Julian_Day (Jday, Y, Month, Day);
end if;
Seconds := Duration (S);
Year := Y;
end Split;
function Time_Of (Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0) return Time is
Date : Time;
S : Time_Float := Time_Float (Seconds);
begin
if Day > Days_In_Month (Month, Year) then
raise Time_Error;
end if;
Date.Julian_Day := Julian_Day_Of (Year, Month, Day);
if S >= Seconds_Per_Day then
Date.Julian_Day := Date.Julian_Day + 1;
S := S - Seconds_Per_Day;
end if;
S := S - Local_Time.Daylight_Savings (Year, Date.Julian_Day);
if S < 0.0 then
Date.Julian_Day := Date.Julian_Day - 1;
S := S + Seconds_Per_Day;
end if;
S := Time_Float (S) + Local_Time.Seconds_From_Gmt;
if S >= Seconds_Per_Day then
Date.Julian_Day := Date.Julian_Day + 1;
S := S - Seconds_Per_Day;
end if;
Date.Sec := Duration (S);
-- date is now converted to GMT, normalized
return Date;
end Time_Of;
function "+" (A, B : Integer) return Integer is
begin
if A < 0 and then B < 0 then
if (Integer'First - A - B) > 0 then
raise Time_Error;
end if;
elsif A > 0 and then B > 0 then
if (Integer'Last - A - B) < 0 then
raise Time_Error;
end if;
end if;
return Standard."+" (A, B);
end "+";
function "+" (Left : Time; Right : Duration) return Time is
Date : Time;
Check : Year_Number;
Secs : Duration;
begin
Date.Julian_Day := Left.Julian_Day;
begin
Secs := Left.Sec + Right;
exception
when Numeric_Error | Constraint_Error =>
Secs := (Left.Sec - Seconds_Per_Day) + Right;
Date.Julian_Day := Date.Julian_Day + 1;
end;
Date.Sec := Secs;
if Date.Sec < 0.0 or else Date.Sec >= Seconds_Per_Day then
while Date.Sec >= Seconds_Per_Day loop
Date.Julian_Day := Date.Julian_Day + 1;
Date.Sec := Date.Sec - Seconds_Per_Day;
end loop;
while Date.Sec < 0.0 loop
Date.Julian_Day := Date.Julian_Day - 1;
Date.Sec := Date.Sec + Seconds_Per_Day;
end loop;
end if;
Check := Year (Date);
return Date;
exception
when others =>
raise Time_Error;
end "+";
function "+" (Left : Duration; Right : Time) return Time is
begin
return Right + Left;
end "+";
function "-" (Left : Time; Right : Duration) return Time is
begin
return Left + (-Right);
end "-";
function "-" (Left : Time; Right : Time) return Duration is
Day_Diff : Integer := Left.Julian_Day - Right.Julian_Day;
Diff : Duration := Left.Sec + (-Right.Sec);
begin
return Duration (Day_Diff * Integer (Seconds_Per_Day)) + Diff;
exception
when Numeric_Error | Constraint_Error =>
raise Time_Error;
end "-";
function "<" (Left, Right : Time) return Boolean is
begin
return Left.Julian_Day < Right.Julian_Day or else
(Left.Julian_Day = Right.Julian_Day and then
Left.Sec < Right.Sec);
end "<";
function "<=" (Left, Right : Time) return Boolean is
begin
return Left.Julian_Day < Right.Julian_Day or else
(Left.Julian_Day = Right.Julian_Day and then
Left.Sec <= Right.Sec);
end "<=";
function ">" (Left, Right : Time) return Boolean is
begin
return Left.Julian_Day > Right.Julian_Day or else
(Left.Julian_Day = Right.Julian_Day and then
Left.Sec > Right.Sec);
end ">";
function ">=" (Left, Right : Time) return Boolean is
begin
return Left.Julian_Day > Right.Julian_Day or else
(Left.Julian_Day = Right.Julian_Day and then
Left.Sec >= Right.Sec);
end ">=";
procedure Set_Clock
(Date : Time;
Timer_Support_Arg : System.Address := System.No_Addr) is
begin
V_I_Time.Set_Time (Date.Julian_Day, Date.Sec, Timer_Support_Arg);
end Set_Clock;
pragma External_Name (Set_Clock, "__SET_CLOCK");
procedure Delay_Until (Date : Time) is
begin
V_I_Time.Delay_Until (Date.Julian_Day, Date.Sec);
end Delay_Until;
pragma External_Name (Delay_Until, "__DELAY_UNTIL");
package body Local_Time is separate;
end Calendar;
nblk1=a
nid=0
hdr6=14
[0x00] rec0=24 rec1=00 rec2=01 rec3=004
[0x01] rec0=26 rec1=00 rec2=02 rec3=01a
[0x02] rec0=1e rec1=00 rec2=03 rec3=07a
[0x03] rec0=1f rec1=00 rec2=04 rec3=054
[0x04] rec0=1d rec1=00 rec2=05 rec3=044
[0x05] rec0=1b rec1=00 rec2=06 rec3=032
[0x06] rec0=1b rec1=00 rec2=07 rec3=06e
[0x07] rec0=1f rec1=00 rec2=08 rec3=006
[0x08] rec0=18 rec1=00 rec2=09 rec3=084
[0x09] rec0=0e rec1=00 rec2=0a rec3=000
tail 0x217541e50874f7b89ef23 0x42a00088462060003