|
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 - metrics - download
Length: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Interval_Value, seg_0522f2, separate Time_Utilities
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
separate (Time_Utilities)
package body Interval_Value is
function Value (S : String) return Interval is
-- format is ddDhh:mm:ss.milli
-- upper or lower case D is a deliminator
-- all non-numeric non delimiters are ignored
-- if only one : is given, it is assumed to separate hrs and seconds
-- 10:17 is 10hrs 17min, :10:17 is 0hrs 10min 17sec
Position : Natural := S'First;
Result : Interval;
type Kind_Value is (Day, Hour, Minute, Second, Millisecond, Number);
type Item;
type Item_Ptr is access Item;
type Item is
record
Kind : Kind_Value;
Value : Natural;
Next : Item_Ptr;
end record;
First_Item : Item_Ptr;
Last_Item : Item_Ptr;
Dot_Observed : Boolean := False;
Colons_Observed : Natural := 0;
function Is_Digit (Char : Character) return Boolean is
begin
case Char is
when '0' .. '9' =>
return True;
when others =>
return False;
end case;
end Is_Digit;
function Is_Delimiter (Char : Character) return Boolean is
begin
case Char is
when ':' | 'D' | 'd' | '/' | '.' =>
return True;
when others =>
return False;
end case;
end Is_Delimiter;
function Get_Number return Item_Ptr is
Start : Natural := Position;
Last : Natural;
function Pad_To_Three_Digits (S : String) return Natural is
begin
if S'Length = 1 then
return Natural'Value (S & "00");
elsif S'Length = 2 then
return Natural'Value (S & '0');
else
return Natural'Value (S (S'First .. S'First + 2));
end if;
end Pad_To_Three_Digits;
function Get_Item (N : Natural) return Item_Ptr is
begin
return new Item'(Kind => Number, Value => N, Next => null);
end Get_Item;
begin
while Position <= S'Last and then Is_Digit (S (Position)) loop
Position := Position + 1;
end loop;
if Position <= S'Last then
Last := Position - 1;
else
Last := S'Last;
end if;
if Dot_Observed then
return Get_Item (Pad_To_Three_Digits (S (Start .. Last)));
else
return Get_Item (Natural'Value (S (Start .. Last)));
end if;
end Get_Number;
function Get_Item return Item_Ptr is
Char : Character;
function Item_Value (Ch : Character) return Item_Ptr is
Result : Item_Ptr := new Item;
begin
case Ch is
when 'D' | 'd' | '/' =>
Result.Kind := Day;
when ':' =>
Result.Kind := Hour;
Colons_Observed := Colons_Observed + 1;
if Colons_Observed > 2 then
raise Constraint_Error;
end if;
when '.' =>
Result.Kind := Second;
Dot_Observed := True;
when others =>
raise Constraint_Error;
end case;
return Result;
end Item_Value;
begin
while Position <= S'Last loop
Char := S (Position);
if Is_Delimiter (Char) then
Position := Position + 1;
return Item_Value (Char);
elsif Is_Digit (Char) then
return Get_Number;
else
Position := Position + 1;
end if;
end loop;
return null;
end Get_Item;
procedure Build_List (First, Last : in out Item_Ptr) is
Next_Item : Item_Ptr;
begin
-- build list of items
Next_Item := Get_Item;
First := Next_Item;
Last := First;
loop
Next_Item := Get_Item;
exit when Next_Item = null;
Last.Next := Next_Item;
Last := Next_Item;
end loop;
end Build_List;
procedure Normalize (First, Last : in out Item_Ptr) is
Hour_Item : Item_Ptr;
Next_Item : Item_Ptr := First;
procedure Add (Kind : Kind_Value) is
New_Item : Item_Ptr := new Item'(Kind, 0, null);
begin
Last.Next := New_Item;
Last := New_Item;
end Add;
begin
if Colons_Observed = 2 or else Dot_Observed then
-- find right_most hour and make it minute
while Next_Item /= null loop
if Next_Item.Kind = Hour then
Hour_Item := Next_Item;
end if;
Next_Item := Next_Item.Next;
end loop;
if Hour_Item /= null then
Hour_Item.Kind := Minute;
end if;
end if;
if Last.Kind = Number then
if Dot_Observed then
Add (Millisecond);
else
case Colons_Observed is
when 2 =>
Add (Second);
when 1 =>
Add (Minute);
when 0 =>
Add (Hour);
when others =>
raise Constraint_Error;
end case;
end if;
end if;
end Normalize;
function Build_Value (First, Last : Item_Ptr) return Interval is
Number_Kind : constant Kind_Value := Number;
Result : Interval := Null_Interval;
Next_Item : Item_Ptr := First;
Number : Natural := 0;
procedure Get_Number (Ptr : in out Item_Ptr;
Value : in out Natural) is
begin
if Ptr.Kind = Number_Kind then
Value := Ptr.Value;
Ptr := Ptr.Next;
else
Value := 0;
end if;
end Get_Number;
procedure Set_Field (Kind : Kind_Value;
Number : Natural;
Result : in out Interval) is
Value : Natural := Number;
begin
if Value = 0 then
return;
end if;
case Next_Item.Kind is
when Day =>
Result.Elapsed_Days :=
Result.Elapsed_Days + Day_Count (Value);
when Hour =>
Value := Value + Natural (Result.Elapsed_Hours);
Set_Field (Day, Value / 24, Result);
Result.Elapsed_Hours := Military_Hours (Value mod 24);
when Minute =>
Value := Value + Natural (Result.Elapsed_Minutes);
Set_Field (Hour, Value / 60, Result);
Result.Elapsed_Minutes := Minutes (Value mod 60);
when Second =>
Value := Value + Natural (Result.Elapsed_Seconds);
Set_Field (Minute, Value / 60, Result);
Result.Elapsed_Seconds := Seconds (Value mod 60);
when Millisecond =>
Value := Value + Natural (Result.Elapsed_Milliseconds);
Set_Field (Second, Value / 1000, Result);
Result.Elapsed_Milliseconds :=
Milliseconds (Value mod 1000);
when others =>
raise Constraint_Error;
end case;
end Set_Field;
begin
while Next_Item /= null loop
Get_Number (Next_Item, Number);
-- increments next_item (if appropriate)
Set_Field (Next_Item.Kind, Number, Result);
Next_Item := Next_Item.Next;
end loop;
return Result;
end Build_Value;
begin
Build_List (First_Item, Last_Item);
Normalize (First_Item, Last_Item);
return Build_Value (First_Item, Last_Item);
end Value;
end Interval_Value;
nblk1=10
nid=0
hdr6=20
[0x00] rec0=1f rec1=00 rec2=01 rec3=054
[0x01] rec0=00 rec1=00 rec2=10 rec3=014
[0x02] rec0=1f rec1=00 rec2=02 rec3=016
[0x03] rec0=00 rec1=00 rec2=0f rec3=002
[0x04] rec0=1d rec1=00 rec2=03 rec3=04e
[0x05] rec0=1f rec1=00 rec2=04 rec3=034
[0x06] rec0=00 rec1=00 rec2=0e rec3=00a
[0x07] rec0=21 rec1=00 rec2=05 rec3=034
[0x08] rec0=00 rec1=00 rec2=0d rec3=01c
[0x09] rec0=1c rec1=00 rec2=06 rec3=052
[0x0a] rec0=01 rec1=00 rec2=0c rec3=004
[0x0b] rec0=1b rec1=00 rec2=07 rec3=028
[0x0c] rec0=00 rec1=00 rec2=0b rec3=00e
[0x0d] rec0=19 rec1=00 rec2=08 rec3=040
[0x0e] rec0=18 rec1=00 rec2=09 rec3=026
[0x0f] rec0=0b rec1=00 rec2=0a rec3=000
tail 0x21759aa7887a067e9f119 0x42a00088462063203