|
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 Generic_String_Sort_Array, seg_047800
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
use Text_Io;
package body Generic_String_Sort_Array is
procedure Put (Collection : in out Object;
Item : in Element;
Ok : out Boolean) is
Index : Element_Index := 1;
Temporary_Array : Unconstraint_Array
(1 .. Collection.Object.Inner'Last + 1);
begin
if Is_Empty (Collection) then
Ok := True;
Collection.Object := (Length => 1, Inner => (others => Item));
else
while Index in Collection.Object.Inner'Range and then
Get_Key (Collection.Object.Inner (Index)) <
Get_Key (Item) loop
Index := Index + 1;
end loop;
if Index not in Collection.Object.Inner'Range then
Ok := True;
Temporary_Array := Collection.Object.Inner & Item;
Collection.Object := (Length => Collection.Object.Length + 1,
Inner => Temporary_Array);
elsif Get_Key (Collection.Object.Inner (Index)) /=
Get_Key (Item) then
Ok := True;
Temporary_Array :=
Collection.Object.Inner (1 .. Index - 1) & Item &
Collection.Object.Inner
(Index .. Collection.Object.Inner'Last);
Collection.Object := (Length => Collection.Object.Length + 1,
Inner => Temporary_Array);
else
Ok := False;
end if;
end if;
end Put;
procedure Put (Collection : in out Object; Item : in Element) is
The_Index : Element_Index := Index (Collection, Get_Key (Item));
Ok : Boolean;
begin
if The_Index = 0 then
Put (Collection, Item, Ok);
else
Collection.Object.Inner (The_Index) := Item;
end if;
end Put;
-- procedure Put (Collection : in out Object;
-- Item : in Element;
-- Index : in Positive;ok : out boolean) is
---
-- begin
-- if index < collection.object.length then
-- collection.object.inner(index) := element;
-- ok := true;
-- else
-- Ok := False;
-- end if;
-- end;
procedure Get (Collection : in Object;
Item : out Element;
Key : in String;
Ok : out Boolean) is
Low, Mid, High : Element_Index;
Item_Ok : Boolean := False;
begin
if Is_Empty (Collection) then
Ok := False;
Item := Null_Element;
else
Low := 1;
High := Collection.Object.Inner'Last;
while Low <= High and not Item_Ok loop
Mid := (Low + High) / 2;
if Get_Key (Collection.Object.Inner (Mid)) < Key then
Low := Mid + 1;
elsif Get_Key (Collection.Object.Inner (Mid)) > Key then
High := Mid - 1;
else
Item_Ok := True;
end if;
end loop;
if Item_Ok then
Ok := True;
Item := Collection.Object.Inner (Mid);
else
Ok := False;
Item := Null_Element;
end if;
end if;
end Get;
procedure Get (Collection : in Object;
Item : out Element;
Key : in Element_Index;
Ok : out Boolean) is
begin
if Key not in Collection.Object.Inner'Range then
Ok := False;
Item := Null_Element;
else
Ok := True;
Item := Collection.Object.Inner (Key);
end if;
end Get;
procedure Show (Collection : in Object) is
An_Iterator : Iterator;
begin
Init (Collection, An_Iterator);
while not Done (An_Iterator) loop
Show_Element (Value (An_Iterator));
Next (An_Iterator);
end loop;
end Show;
function Is_Empty (Collection : in Object) return Boolean is
begin
return Collection.Object.Length = 0;
end Is_Empty;
function Index (Collection : in Object; Key : in String)
return Element_Index is
Low, Mid, High : Element_Index;
Item_Ok : Boolean := False;
Index : Element_Index := 0;
begin
if not Is_Empty (Collection) then
Low := 1;
High := Collection.Object.Inner'Last;
while Low <= High and not Item_Ok loop
Mid := (Low + High) / 2;
if Get_Key (Collection.Object.Inner (Mid)) < Key then
Low := Mid + 1;
elsif Get_Key (Collection.Object.Inner (Mid)) > Key then
High := Mid - 1;
else
Item_Ok := True;
end if;
end loop;
if Item_Ok then
Index := Mid;
end if;
end if;
return Index;
end Index;
function Belong (Collection : in Object; Key : in String) return Boolean is
begin
return Index (Collection, Key) /= 0;
end Belong;
function Number_Of (Collection : in Object) return Element_Index is
begin
return Collection.Object.Length;
end Number_Of;
procedure Init (Collection : in Object; An_Iterator : in out Iterator) is
begin
if Is_Empty (Collection) then
An_Iterator.Collection := Null_Object;
An_Iterator.Index := 0;
else
An_Iterator.Collection := Collection;
An_Iterator.Index := 1;
end if;
end Init;
function Done (An_Iterator : in Iterator) return Boolean is
begin
if Is_Empty (An_Iterator.Collection) then
return True;
else
return An_Iterator.Index = An_Iterator.Collection.Object.Length + 1;
end if;
end Done;
function Value (An_Iterator : in Iterator) return Element is
begin
if An_Iterator.Index > 0 and not Done (An_Iterator) then
return An_Iterator.Collection.Object.Inner (An_Iterator.Index);
else
return Null_Element;
end if;
end Value;
-- function index (An_Iterator : in Iterator) return natural is
--
-- begin
-- return an_iterator.index;
-- end index;
procedure Next (An_Iterator : in out Iterator) is
begin
if not Done (An_Iterator) then
An_Iterator.Index := An_Iterator.Index + 1;
end if;
end Next;
end Generic_String_Sort_Array;
nblk1=a
nid=8
hdr6=10
[0x00] rec0=1c rec1=00 rec2=01 rec3=078
[0x01] rec0=1a rec1=00 rec2=07 rec3=04e
[0x02] rec0=21 rec1=00 rec2=03 rec3=016
[0x03] rec0=1e rec1=00 rec2=0a rec3=03a
[0x04] rec0=14 rec1=00 rec2=05 rec3=016
[0x05] rec0=1f rec1=00 rec2=04 rec3=014
[0x06] rec0=22 rec1=00 rec2=09 rec3=04e
[0x07] rec0=1a rec1=00 rec2=02 rec3=000
[0x08] rec0=18 rec1=00 rec2=02 rec3=000
[0x09] rec0=2d rec1=0c rec2=14 rec3=6c4
tail 0x2154491b48654602b9ede 0x42a00088462060003
Free Block Chain:
0x8: 0000 00 06 00 04 80 01 20 01 02 20 20 20 20 62 65 67 ┆ beg┆
0x6: 0000 00 00 03 fc 80 41 20 20 20 20 20 20 20 20 20 77 ┆ A w┆