DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦ef86ac138⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_String_Sort_Array, seg_041239

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



package body Generic_String_Sort_Array is


    procedure Put (Collection : in out Object;
                   Item : in Element;
                   Found : out Boolean) is

        Index : Element_Index := 1;
        Temporary_Array : Unconstraint_Array
                             (1 .. Collection.The_Array.Inner'Last + 1);

    begin
        if Is_Empty (Collection) then
            Found := False;
            Collection.The_Array := (Length => 1, Inner => (others => Item));
        else
            while Index in Collection.The_Array.Inner'Range and then
                     Get_Key (Collection.The_Array.Inner (Index)) <
                        Get_Key (Item) loop
                Index := Index + 1;
            end loop;
            if Index not in Collection.The_Array.Inner'Range then  
                Found := False;
                Temporary_Array := Collection.The_Array.Inner & Item;
                Collection.The_Array := (Length =>
                                            Collection.The_Array.Length + 1,
                                         Inner => Temporary_Array);
            elsif Get_Key (Collection.The_Array.Inner (Index)) /=
                  Get_Key (Item) then
                Found := False;
                Temporary_Array :=
                   Collection.The_Array.Inner (1 .. Index - 1) & Item &
                      Collection.The_Array.Inner
                         (Index .. Collection.The_Array.Inner'Last);
                Collection.The_Array := (Length =>
                                            Collection.The_Array.Length + 1,
                                         Inner => Temporary_Array);
            else
                Found := True;
            end if;
        end if;
    end Put;

    procedure Put (Collection : in out Object; Item : in Element) is

        Index : Element_Index := 1;

    begin
        if not Is_Empty (Collection) then
            while Index in Collection.The_Array.Inner'Range and then
                     Get_Key (Collection.The_Array.Inner (Index)) /=
                        Get_Key (Item) loop
                Index := Index + 1;
            end loop;
            if Index in Collection.The_Array.Inner'Range then  
                Collection.The_Array.Inner (Index) := Item;
            end if;
        end if;
    end Put;

    procedure Get (Collection : in Object;
                   Item : out Element;
                   Key : in String;
                   Found : out Boolean) is

        Low, Mid, High : Element_Index;
        Item_Found : Boolean := False;

    begin
        if Is_Empty (Collection) then
            Found := False;
        else
            Low := 1;
            High := Collection.The_Array.Inner'Last;
            while Low <= High and not Item_Found loop
                Mid := (Low + High) / 2;
                if Get_Key (Collection.The_Array.Inner (Mid)) < Key then
                    Low := Mid + 1;  
                elsif Get_Key (Collection.The_Array.Inner (Mid)) > Key then
                    High := Mid - 1;
                else
                    Item_Found := True;
                end if;
            end loop;  
            if Item_Found then
                Found := True;
                Item := Collection.The_Array.Inner (Mid);
            else
                Found := False;
                Item := Null_Element;
            end if;
        end if;
    end Get;

    procedure Get (Collection : in Object;
                   Item : out Element;
                   Key : in Element_Index;
                   Found : out Boolean) is

    begin
        if Key not in Collection.The_Array.Inner'Range then
            Found := False;
            Item := Null_Element;
        else
            Found := True;
            Item := Collection.The_Array.Inner (Key);
        end if;
    end Get;

    procedure Image (Collection : in Object) is

        An_Iterator : Iterator;

    begin
        Create (Collection, An_Iterator);
        while not Is_At_End (An_Iterator) loop
            Element_Image (Value (An_Iterator));
            Next (An_Iterator);
        end loop;
    end Image;

    function Is_Empty (Collection : in Object) return Boolean is

    begin
        return Collection.The_Array.Length = 0;
    end Is_Empty;

    function Index (Collection : in Object; Key : in String)
                   return Element_Index is

        Low, Mid, High : Element_Index;
        Item_Found : Boolean := False;
        Index : Element_Index := 0;

    begin
        if not Is_Empty (Collection) then
            Low := 1;
            High := Collection.The_Array.Inner'Last;
            while Low <= High and not Item_Found loop
                Mid := (Low + High) / 2;
                if Get_Key (Collection.The_Array.Inner (Mid)) < Key then
                    Low := Mid + 1;  
                elsif Get_Key (Collection.The_Array.Inner (Mid)) > Key then
                    High := Mid - 1;
                else
                    Item_Found := True;
                end if;
            end loop;  
            if Item_Found then
                Index := Mid;
            end if;
        end if;  
        return Index;
    end Index;

    procedure Create (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 Create;

    function Is_At_End (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.The_Array.Length + 1;
        end if;
    end Is_At_End;

    function Value (An_Iterator : in Iterator) return Element is

    begin
        if An_Iterator.Index > 0 and not Is_At_End (An_Iterator) then
            return An_Iterator.Collection.The_Array.Inner (An_Iterator.Index);
        else
            return Null_Element;
        end if;
    end Value;

    procedure Next (An_Iterator : in out Iterator) is

    begin
        if not Is_At_End (An_Iterator) then  
            An_Iterator.Index := An_Iterator.Index + 1;
        end if;
    end Next;

end Generic_String_Sort_Array;


E3 Meta Data

    nblk1=a
    nid=5
    hdr6=10
        [0x00] rec0=1b rec1=00 rec2=01 rec3=012
        [0x01] rec0=18 rec1=00 rec2=06 rec3=026
        [0x02] rec0=1b rec1=00 rec2=03 rec3=080
        [0x03] rec0=21 rec1=00 rec2=0a rec3=000
        [0x04] rec0=03 rec1=00 rec2=08 rec3=022
        [0x05] rec0=1f rec1=00 rec2=07 rec3=038
        [0x06] rec0=20 rec1=00 rec2=04 rec3=07e
        [0x07] rec0=18 rec1=00 rec2=02 rec3=001
        [0x08] rec0=57 rec1=3c rec2=00 rec3=006
        [0x09] rec0=2d rec1=0c rec2=14 rec3=6c4
    tail 0x217416b70861352a9f8c0 0x42a00088462060003
Free Block Chain:
  0x5: 0000  00 09 00 14 80 0b 53 6f 72 74 5f 41 72 72 61 79  ┆      Sort_Array┆
  0x9: 0000  00 00 00 0a 80 07 72 72 61 79 20 3a 3d 07 74 5f  ┆      rray := t_┆