|
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: 19456 (0x4c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Interval_Value, package body Time_Utilities, seg_022c66, seg_027c6c, seg_027d07
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Enumeration_Value;
with Machine_Independent_Integer32;
with String_Utilities;
package body Time_Utilities is
package Mii renames Machine_Independent_Integer32;
subtype Integer32 is Mii.Integer32;
function "+" (L, R : Integer32) return Integer32 renames Mii."+";
function "-" (L, R : Integer32) return Integer32 renames Mii."-";
function "*" (L : Integer32; R : Integer) return Integer32 renames Mii."*";
function "/" (L : Integer32; R : Integer) return Integer32 renames Mii."/";
function "=" (L, R : Integer32) return Boolean renames Mii."=";
function "<" (L, R : Integer32) return Boolean renames Mii."<";
Zero : constant Integer32 := Integer32 (0);
Seconds_Per_Minute : constant := 60;
Seconds_Per_Hour : constant := 60 * Seconds_Per_Minute;
Seconds_Per_Half_Day : constant := 12 * Seconds_Per_Hour;
Null_Calendar_Time : Calendar.Time;
type Number_Array is array (Positive range <>) of Natural;
type Character_Map is array (Character) of Boolean;
Is_Numeric : constant Character_Map :=
Character_Map'('0' | '1' | '2' | '3' | '4' |
'5' | '6' | '7' | '8' | '9' => True,
others => False);
Is_Alphabetic : constant Character_Map :=
Character_Map'('a' .. 'z' | 'A' .. 'Z' => True, others => False);
Null_Time : constant Time := Time'(Year => Years'First,
Month => Months'First,
Day => Days'First,
Hour => Hours'First,
Minute => Minutes'First,
Second => Seconds'First,
Sun_Position => Sun_Positions'First);
Null_Interval : constant Interval :=
Interval'(Elapsed_Days => Day_Count'First,
Elapsed_Hours => Military_Hours'First,
Elapsed_Minutes => Minutes'First,
Elapsed_Seconds => Seconds'First,
Elapsed_Milliseconds => Milliseconds'First);
Military_Hour : constant array (Sun_Positions, Hours) of Military_Hours :=
(Am => (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 0),
Pm => (13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 12));
-- used in day of week calculation
Days_In_Month : constant array (Months) of Integer :=
(January | March | May | July | August | October | December => 31,
April | June | September | November => 30,
February => 28);
function Image (Value : Integer;
Base : Natural := 10;
Width : Natural := 2;
Leading : Character := '0') return String
renames String_Utilities.Number_To_String;
package Interval_Value is
-- Hack to get around RCG bug
function Value (S : String) return Interval;
end Interval_Value;
procedure Unique_Prefix is new Enumeration_Value (Months);
function Convert_Time (Date : Calendar.Time) return Time is
Result : Time;
C_Year : Calendar.Year_Number;
C_Month : Calendar.Month_Number;
C_Day : Calendar.Day_Number;
C_Second : Calendar.Day_Duration;
Total_Seconds : Integer32;
Hour_Offset : Integer32;
Junk, Min, Sec : Integer32;
begin
Calendar.Split (Date, C_Year, C_Month, C_Day, C_Second);
Result.Year := Years (C_Year);
Result.Month := Months'Val (C_Month - 1);
Result.Day := Days (C_Day);
Total_Seconds := Integer32 (C_Second);
if Total_Seconds < Integer32 (Seconds_Per_Half_Day) then
Result.Sun_Position := Am;
else
Result.Sun_Position := Pm;
Total_Seconds := Total_Seconds - Integer32 (Seconds_Per_Half_Day);
end if;
Hour_Offset := Total_Seconds / Seconds_Per_Hour;
if Hour_Offset = Zero then
Result.Hour := 12;
Result.Sun_Position := Pm;
else
Result.Hour := Hours (Hour_Offset);
end if;
--- Total_Seconds := Total_Seconds rem Seconds_Per_Hour; --tjl was MOD
Mii.Div_Rem (Total_Seconds, Seconds_Per_Hour, Junk, Total_Seconds);
Mii.Div_Rem (Total_Seconds, Seconds_Per_Minute, Min, Sec);
Result.Minute := Minutes (Min);
Result.Second := Seconds (Sec);
--- Result.Minute := Minutes (Total_Seconds / Seconds_Per_Minute);
--- Result.Second := Seconds (Total_Seconds rem Seconds_Per_Minute);--tjl
return Result;
end Convert_Time;
function Convert_Time (Date : Time) return Calendar.Time is
C_Year : Calendar.Year_Number;
C_Month : Calendar.Month_Number;
C_Day : Calendar.Day_Number;
Total_Seconds : Integer32;
begin
C_Year := Calendar.Year_Number (Date.Year);
C_Month := Calendar.Month_Number (Months'Pos (Date.Month) + 1);
C_Day := Calendar.Day_Number (Date.Day);
Total_Seconds := Integer32 (Date.Second) +
Integer32 (Date.Minute) * Seconds_Per_Minute;
if Date.Hour /= 12 then
Total_Seconds := Total_Seconds +
Integer32 (Date.Hour) * Seconds_Per_Hour;
end if;
if Date.Sun_Position = Pm then
Total_Seconds := Total_Seconds + Integer32 (Seconds_Per_Half_Day);
end if;
return Calendar.Time_Of (C_Year, C_Month, C_Day,
Duration (Total_Seconds));
exception
when Calendar.Time_Error =>
return Calendar.Clock;
end Convert_Time;
function Get_Time return Time is
begin
return Convert_Time (Calendar.Clock);
end Get_Time;
function Image (Month : Months; Full_Width : Boolean := True)
return String is
Name : constant String := Months'Image (Month);
begin
if Full_Width then
return String_Utilities.Capitalize (Name);
else
return Name (Name'First .. Name'First + 2);
end if;
end Image;
function Time_Image (Date : Time; Time_Style : Time_Format) return String is
Sep : Character := ':';
Hour : Integer := Integer (Military_Hour
(Date.Sun_Position, Date.Hour));
begin
case Time_Style is
when Expanded =>
return Image (Integer (Date.Hour), Width => 0) &
Sep & Image (Integer (Date.Minute)) & Sep &
Image (Integer (Date.Second)) & ' ' &
Sun_Positions'Image (Date.Sun_Position);
when Military | Ada =>
if Time_Style = Ada then
Sep := '_';
end if;
return Image (Hour) & Sep & Image (Integer (Date.Minute)) &
Sep & Image (Integer (Date.Second));
when Short =>
return Image (Hour) & Sep & Image (Integer (Date.Minute));
end case;
end Time_Image;
function Date_Image (Date : Time; Date_Style : Date_Format) return String is
Sep : Character := '/';
Year : Integer := Integer (Date.Year) mod 100;
Month : Integer := Months'Pos (Date.Month) + 1;
begin
case Date_Style is
when Expanded =>
return Image (Date.Month) & ' ' &
Image (Integer (Date.Day), Width => 0) & ',' &
Image (Integer (Date.Year),
Leading => ' ',
Width => 5);
when Month_Day_Year =>
return Image (Month, Leading => ' ') & Sep &
Image (Integer (Date.Day)) & Sep & Image (Year);
when Day_Month_Year =>
Sep := '-';
return Image (Integer (Date.Day), Leading => ' ') & Sep &
Image (Date.Month, Full_Width => False) &
Sep & Image (Year);
when Year_Month_Day | Ada =>
if Date_Style = Ada then
Sep := '_';
end if;
return Image (Year) & Sep & Image (Month) &
Sep & Image (Integer (Date.Day));
end case;
end Date_Image;
function Separator (Date_Style : Date_Format; Time_Style : Time_Format)
return String is
begin
if Date_Style = Ada and then Time_Style = Ada then
return "_at_";
elsif Date_Style = Expanded then
return " at ";
else
return " ";
end if;
end Separator;
function Image (Date : Time;
Date_Style : Date_Format := Expanded;
Time_Style : Time_Format := Expanded;
Contents : Image_Contents := Both) return String is
begin
case Contents is
when Both =>
return Date_Image (Date, Date_Style) &
Separator (Date_Style, Time_Style) &
Time_Image (Date, Time_Style);
when Date_Only =>
return Date_Image (Date, Date_Style);
when Time_Only =>
return Time_Image (Date, Time_Style);
end case;
end Image;
function Time_Stamp_Image
(Date : Time := Get_Time; Style : Time_Format := Military)
return String is
begin
if Style = Short then
return Image (Integer (Date.Minute)) & ':' &
Image (Integer (Date.Second));
else
return Time_Image (Date, Style);
end if;
end Time_Stamp_Image;
function Convert (I : Interval) return Duration is
Seconds : Duration := Duration (I.Elapsed_Milliseconds) / 1000;
begin
Seconds := Duration (I.Elapsed_Seconds) + Seconds;
Seconds := Duration (Duration (I.Elapsed_Minutes) * Minute) + Seconds;
Seconds := Duration (Duration (I.Elapsed_Hours) * Hour) + Seconds;
Seconds := Duration (Duration (I.Elapsed_Days) * Day) + Seconds;
return Seconds;
end Convert;
function Convert (D : Duration) return Interval is
I : Interval;
Milliseconds_Per_Second : constant := 1000;
Milliseconds_Per_Minute : constant := 60 * Milliseconds_Per_Second;
Milliseconds_Per_Hour : constant := 60 * Milliseconds_Per_Minute;
Milliseconds_Per_Day : constant := 24 * Milliseconds_Per_Hour;
Rest : Integer32 := Integer32 (D) * Milliseconds_Per_Second
;
begin
if D < 0.0 then
return Null_Interval;
end if;
I.Elapsed_Days := Day_Count (Rest / Milliseconds_Per_Day);
Rest := Rest - (Integer32 (I.Elapsed_Days) * Milliseconds_Per_Day);
I.Elapsed_Hours := Military_Hours (Rest / Milliseconds_Per_Hour);
Rest := Rest - (Integer32 (I.Elapsed_Hours) * Milliseconds_Per_Hour);
I.Elapsed_Minutes := Minutes (Rest / Milliseconds_Per_Minute);
Rest := Rest - (Integer32 (I.Elapsed_Minutes) *
Milliseconds_Per_Minute);
I.Elapsed_Seconds := Seconds (Rest / Milliseconds_Per_Second);
Rest := Rest - (Integer32 (I.Elapsed_Seconds) *
Milliseconds_Per_Second);
I.Elapsed_Milliseconds := Milliseconds (Rest);
return I;
end Convert;
package body Interval_Value is separate;
function Value (S : String) return Interval is
begin
return Interval_Value.Value (S);
end Value;
function Time_Value (S : String) return Time is separate;
function Value (S : String) return Time is
begin
return Time_Value (S);
end Value;
function Image (D : Duration) return String is
begin
return Image (Convert (D));
end Image;
function Image (I : Interval) return String is
begin
if I.Elapsed_Days > 99999 then
return Image (Natural (I.Elapsed_Days), Width => 0) & 'D';
elsif I.Elapsed_Days > 99 then
return Image
(Natural (I.Elapsed_Days), Width => 5, Leading => ' ') &
'/' & Image (Natural (I.Elapsed_Hours));
elsif I.Elapsed_Days > 0 then
return Image (Natural (I.Elapsed_Days), Leading => ' ') &
'/' & Image (Natural (I.Elapsed_Hours)) &
':' & Image (Natural (I.Elapsed_Minutes));
elsif I.Elapsed_Hours > 0 then
return Image (Natural (I.Elapsed_Hours), Leading => ' ') &
':' & Image (Natural (I.Elapsed_Minutes)) &
':' & Image (Natural (I.Elapsed_Seconds));
elsif I.Elapsed_Minutes > 0 then
return Image (Natural (I.Elapsed_Minutes), Leading => ' ') &
':' & Image (Natural (I.Elapsed_Seconds)) & '.' &
Image (Natural (I.Elapsed_Milliseconds), Width => 3);
else
return Image (Natural (I.Elapsed_Seconds), Leading => ' ') & '.' &
Image (Natural (I.Elapsed_Milliseconds), Width => 3);
end if;
end Image;
function Nil return Time is
begin
return Null_Time;
end Nil;
function Is_Nil (Date : Time) return Boolean is
begin
return Date = Nil;
end Is_Nil;
function Nil return Calendar.Time is
begin
return Null_Calendar_Time;
end Nil;
function Is_Nil (Date : Calendar.Time) return Boolean is
begin
return Calendar."=" (Date, Nil);
end Is_Nil;
function Image (D : Weekday) return String is
begin
case D is
when 1 =>
return "Monday";
when 2 =>
return "Tuesday";
when 3 =>
return "Wednesday";
when 4 =>
return "Thursday";
when 5 =>
return "Friday";
when 6 =>
return "Saturday";
when 7 =>
return "Sunday";
end case;
end Image;
function Make_Weekday (D : Integer) return Weekday is
Day : Integer := D mod 7;
begin
if Day = 0 then
return 7;
else
return Weekday (Day);
end if;
end Make_Weekday;
pragma Inline (Make_Weekday);
function Day_Of_Week (T : Time := Get_Time) return Weekday is
-- Uses Zeller's congruence to compute the day of week of given date.
-- See "Problems for Computer Solutions", Gruenberger & Jaffray, Wiley,
-- 1965, p. 255ff.
Zyear, Zmonth, Zcentury, Zyy : Integer;
begin
-- Remap month# so Mar=1 & Jan, Feb=11, 12 of PRECEDING year
if Months'Pos (T.Month) >= 3 then
Zyear := Integer (T.Year);
Zmonth := Months'Pos (T.Month) - 1;
else -- Jan or Feb
Zyear := Integer (T.Year) - 1;
Zmonth := Months'Pos (T.Month) + 11;
end if;
Zcentury := Zyear / 100;
Zyy := Zyear rem 100;
return Make_Weekday (((26 * Zmonth - 2) / 10) + Integer (T.Day) +
Zyy + (Zyy / 4) + (Zcentury / 4) - 2 * Zcentury);
end Day_Of_Week;
function Day_Of_Week (T : Calendar.Time) return Weekday is
begin
return Day_Of_Week (Convert_Time (T));
end Day_Of_Week;
function "+" (D : Weekday; I : Integer) return Weekday is
begin
return Make_Weekday (Integer (D) + I);
end "+";
function "-" (D : Weekday; I : Integer) return Weekday is
begin
return Make_Weekday (Integer (D) - I);
end "-";
function Duration_Until (T : Calendar.Time) return Duration is
begin
return Calendar."-" (T, Calendar.Clock);
end Duration_Until;
function Duration_Until (T : Time) return Duration is
begin
return Duration_Until (Convert_Time (T));
end Duration_Until;
function Duration_Until_Next
(H : Military_Hours; M : Minutes := 0; S : Seconds := 0)
return Duration is
T : Time := Get_Time;
D : Duration;
Hr : Natural := Natural (H);
begin
T.Minute := M;
T.Second := S;
if Hr >= 12 then
T.Sun_Position := Pm;
Hr := Hr - 12;
else
T.Sun_Position := Am;
end if;
if Hr = 0 then
T.Hour := 12;
else
T.Hour := Hours (Hr);
end if;
D := Duration_Until (T);
if D < 0.0 then
D := Day + D;
end if;
return D;
end Duration_Until_Next;
begin
Null_Calendar_Time := Convert_Time (Null_Time);
end Time_Utilities;
nblk1=12
nid=0
hdr6=24
[0x00] rec0=19 rec1=00 rec2=01 rec3=008
[0x01] rec0=12 rec1=00 rec2=02 rec3=02e
[0x02] rec0=18 rec1=00 rec2=03 rec3=02e
[0x03] rec0=1e rec1=00 rec2=04 rec3=04e
[0x04] rec0=1d rec1=00 rec2=05 rec3=030
[0x05] rec0=1c rec1=00 rec2=06 rec3=05a
[0x06] rec0=18 rec1=00 rec2=07 rec3=02c
[0x07] rec0=19 rec1=00 rec2=08 rec3=06c
[0x08] rec0=1c rec1=00 rec2=09 rec3=016
[0x09] rec0=1a rec1=00 rec2=0a rec3=05e
[0x0a] rec0=1b rec1=00 rec2=0b rec3=048
[0x0b] rec0=1e rec1=00 rec2=0c rec3=044
[0x0c] rec0=20 rec1=00 rec2=0d rec3=04e
[0x0d] rec0=1d rec1=00 rec2=0e rec3=04c
[0x0e] rec0=29 rec1=00 rec2=0f rec3=008
[0x0f] rec0=16 rec1=00 rec2=10 rec3=072
[0x10] rec0=22 rec1=00 rec2=11 rec3=024
[0x11] rec0=15 rec1=00 rec2=12 rec3=000
tail 0x2171e576483966065feab 0x42a00088462060003