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

⟦97684f295⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body T_Tree, seg_03fdeb

Derivation

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

with Unchecked_Deallocation, T_Stack, Text_Io;

package body T_Tree is

    procedure Free is new Unchecked_Deallocation (Tree_Cell, Ttree);



    procedure Create (A : in out Ttree) is
    begin
        A := null;
    end Create;

    function Empty (A : Ttree) return Boolean is
    begin
        return (A = null);
    end Empty;

    function Left (A : Ttree) return Ttree is
    begin
        return A.all.Left;
    end Left;

    function Right (A : Ttree) return Ttree is
    begin
        return A.all.Right;
    end Right;


    procedure Build (X : T; Node : in out Ttree; Sad, Sag : Ttree) is
    begin
        Node := new Tree_Cell;
        Affect (Node.all.Element, X);
        Node.all.Left := Sag;
        Node.all.Right := Sad;

    exception
        when others =>
            raise Error_Ttree_Allocation;
    end Build;

    procedure Build (X : T; Node : in out Ttree) is
    begin
        Node := new Tree_Cell;
        Affect (Node.all.Element, X);
        Node.all.Left := null;
        Node.all.Right := null;

    exception
        when others =>
            raise Error_Ttree_Allocation;
    end Build;

    function Get (A : Ttree) return T is
    begin
        return A.all.Element;
    end Get;

    procedure Put (X : T; A : in out Ttree) is
    begin
        Affect (A.all.Element, X);
    end Put;



    procedure Create_Iterator (A : Ttree; I : in out Tree_Index) is
        G : Ttree;
    begin
        Stack_Node.Create (I.Ptr);
        Stack_Node.Push (I.Ptr, A);
        G := A;
        while (G.all.Left /= null) loop
            Stack_Node.Push (I.Ptr, G.all.Left);
            G := G.all.Left;
        end loop;
    end Create_Iterator;


    function Current_Iterator (I : Tree_Index) return Ttree is

    begin
        return Stack_Node.Get (I.Ptr);
    end Current_Iterator;

    function End_Iterator (I : Tree_Index) return Boolean is

    begin
        return Stack_Node.Empty (I.Ptr);
    end End_Iterator;

    procedure Next_Iterator (I : in out Tree_Index) is
        The_Top, Left_Tree : Ttree;
    begin
        if not (Stack_Node.Empty (I.Ptr)) then
            The_Top := Stack_Node.Get (I.Ptr);
            Stack_Node.Pop (I.Ptr);
            if not (Empty (The_Top.all.Right)) then
                Stack_Node.Push (I.Ptr, The_Top.all.Right);
                Left_Tree := The_Top.all.Right.all.Left;

                while not (Empty (Left_Tree)) loop
                    Stack_Node.Push (I.Ptr, Left_Tree);
                    Left_Tree := Left_Tree.all.Left;
                end loop;
            end if;
        end if;
    end Next_Iterator;

    procedure Dump (A : Ttree) is
        Index : Tree_Index;
    begin
        Create_Iterator (A, Index);
        while not (End_Iterator (Index)) loop
            Print (Get (Current_Iterator (Index)));
            Next_Iterator (Index);
        end loop;
    end Dump;

    procedure Insert (X : T; A : in out Ttree) is
        Current : T;
    begin
        if Empty (A) then
            Build (X, A);
        else
            Affect (Current, Get (A));
            if Compare (Current, X) = Sup then
                Insert (X, A.all.Left);
            else
                Insert (X, A.all.Right);
            end if;
        end if;

    end Insert;

    procedure Search (X : T; A : Ttree; Found : in out Ttree) is
        Index : Tree_Index;
    begin
        Create_Iterator (A, Index);
        Found := null;

        Search_Loop:
            while not (End_Iterator (Index)) loop
                if Compare (X, Get (Current_Iterator (Index))) = Equ then
                    Found := Current_Iterator (Index);
                    exit Search_Loop;
                else
                    Next_Iterator (Index);
                end if;
            end loop Search_Loop;
    end Search;


end T_Tree;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=2d rec1=00 rec2=01 rec3=032
        [0x01] rec0=29 rec1=00 rec2=02 rec3=054
        [0x02] rec0=1e rec1=00 rec2=03 rec3=014
        [0x03] rec0=22 rec1=00 rec2=04 rec3=024
        [0x04] rec0=05 rec1=00 rec2=05 rec3=001
    tail 0x21539f8a4860c58958d9e 0x42a00088462060003