|
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: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, function Interval_Value, seg_014222, separate Time_Utilities
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
separate (Time_Utilities)
function Interval_Value (S : String) return Interval is
-- format is ddDhh:mm:ss.milli
-- upper or lower case D is a delimiter
-- 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 Interval_Value;
nblk1=9
nid=0
hdr6=12
[0x00] rec0=24 rec1=00 rec2=01 rec3=036
[0x01] rec0=23 rec1=00 rec2=02 rec3=020
[0x02] rec0=22 rec1=00 rec2=03 rec3=036
[0x03] rec0=25 rec1=00 rec2=04 rec3=002
[0x04] rec0=21 rec1=00 rec2=05 rec3=042
[0x05] rec0=22 rec1=00 rec2=06 rec3=03e
[0x06] rec0=1e rec1=00 rec2=07 rec3=010
[0x07] rec0=18 rec1=00 rec2=08 rec3=02a
[0x08] rec0=0e rec1=00 rec2=09 rec3=000
tail 0x2150ef5d483127f96b20b 0x42a00088462060003