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

⟦80b5b0ab7⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Symbols, seg_04196f

Derivation

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

with Dynamic_Object, Text_Io, Bounded_String, Binary_Trees_Pkg;

package body Symbols is

    use Symbols_Tree;

    Inf : constant Integer := -1;
    Equ : constant Integer := 0;
    Sup : constant Integer := 1;

    Current_Symbol : Symbol;
    Lookahead : Boolean;

    function Create_Symbol
                (N : String; T : String; F : Dynamic_Object.Dynamic_Object)
                return Symbol is
        A : Symbol;
    begin
        Bounded_String.Free (A.Symbol_Name);
        Bounded_String.Copy (A.Symbol_Name, N);
        Bounded_String.Free (A.Symbol_Type);
        Bounded_String.Copy (A.Symbol_Type, T);
        Dynamic_Object.Surface_Copy (A.Symbol_Value, F);
        return A;
    end Create_Symbol;


    function Compare (A, B : Symbol) return Integer is
    begin
        declare
            use Bounded_String;
        begin
            if Image (A.Symbol_Name) < Image (B.Symbol_Name) then
                return Inf;
            elsif Image (A.Symbol_Name) = Image (B.Symbol_Name) then
                return Equ;
            else
                return Sup;
            end if;
        end;
    end Compare;

    procedure Dispose_Symbol (The_Symbol : in out Symbol) is
    begin
        Dynamic_Object.Dispose_Object (The_Symbol.Symbol_Value);
        Bounded_String.Free (The_Symbol.Symbol_Name);
        Bounded_String.Free (The_Symbol.Symbol_Type);
    end Dispose_Symbol;
    procedure Destroy_Object is new Destroy_Deep (Free_Value => Dispose_Symbol);




    procedure Dump_An_Symbol (A : Symbol) is
    begin
        Text_Io.Put_Line ("........................................");
        Text_Io.Put_Line
           (Bounded_String.Image (A.Symbol_Name) & " " &
            Bounded_String.Image (A.Symbol_Type) & "With Object:");
        Dynamic_Object.Dump_Object_Attributes (A.Symbol_Value);
    end Dump_An_Symbol;
    procedure Dump is new Visit (Process => Dump_An_Symbol);




--Creation
    procedure Create (D : in out Object) is
    begin
        D.Node := Symbols_Tree.Create;
    end Create;



--Access
    procedure Dump_Number_Of_Symbol (D : in Object) is
    begin
        Text_Io.Put_Line ("Number of Symbol:" &
                          Natural'Image (Symbols_Tree.Size (D.Node)));
    end Dump_Number_Of_Symbol;


    function Has_Symbol (D : in Object; Name : in String) return Boolean is
        A : Symbol;
        F : Dynamic_Object.Dynamic_Object;
    begin
        Dynamic_Object.New_Object (F);
        A := Create_Symbol (Name, Name,
                            F);  -- Only the first param. is important
        return Symbols_Tree.Is_Found (A, D.Node);
    end Has_Symbol;

    function Get_Symbol_Type_By_Name
                (D : Object; Name : String) return String is
        Found : Boolean := False;
        A : Symbol;
        B : Dynamic_Object.Dynamic_Object;
    begin
        Dynamic_Object.New_Object (B);
        A := Create_Symbol (Name, Name,
                            B);  -- Only the first param. is important
        Symbols_Tree.Find (A, D.Node, Found, A);
        if Found then
            return Bounded_String.Image (A.Symbol_Type);
        else
            return "";
        end if;
    exception
        when others =>
            raise Error_Symbol_Search;
    end Get_Symbol_Type_By_Name;

    procedure Get_Symbol_Value_By_Name
                 (D : Object;
                  Name : String;
                  F : in out Dynamic_Object.Dynamic_Object) is
        Found : Boolean := False;
        A : Symbol;
        B : Dynamic_Object.Dynamic_Object;
    begin
        Dynamic_Object.New_Object (B);
        A := Create_Symbol (Name, Name,
                            B);  -- Only the first param. is important
        Symbols_Tree.Find (A, D.Node, Found, A);
        if Found then
            Dynamic_Object.Copy_Object (F, A.Symbol_Value);
        end if;
    exception
        when others =>
            raise Error_Symbol_Search;
    end Get_Symbol_Value_By_Name;



    procedure Dump_Symbols (D : in Object) is
    begin
        Dump (D.Node, Symbols_Tree.Inorder);
    end Dump_Symbols;



--Modification
    procedure Store_Symbol (D : in out Object;
                            Aname : String;
                            Atype : String;
                            F : Dynamic_Object.Dynamic_Object) is
        Found : Boolean := False;
        A : Symbol;
        B : Dynamic_Object.Dynamic_Object;
    begin
        Dynamic_Object.New_Object (B);
        Dynamic_Object.Copy_Object (B, F);
        Symbols_Tree.Replace_If_Found
           (Create_Symbol (Aname, Atype, B), D.Node, Found, A);
        if Found then
            Dispose_Symbol (A);
        end if;
    exception
        when others =>
            raise Error_Symbol_Store;
    end Store_Symbol;



--Liberation
    procedure Dispose_Object (D : in out Object) is
    begin
        Destroy_Object (D.Node);
    end Dispose_Object;


--Iteration
    procedure Open_Symbol_Indexation (D : Object; I : in out Symbol_Index) is
    begin
        I.Node := Symbols_Tree.Make_Iter (D.Node);
        Lookahead := False;
        Next_Symbol_Index (I);
    end Open_Symbol_Indexation;

    procedure Next_Symbol_Index (I : in out Symbol_Index) is
    begin
        if not Lookahead then
            if Symbols_Tree.More (I.Node) then
                Symbols_Tree.Next (I.Node, Current_Symbol);
            else
                raise Error_Symbol_Index;
            end if;
        end if;
    end Next_Symbol_Index;




    function Get_Indexed_Symbol_Name (I : Symbol_Index) return String is
    begin
        return Bounded_String.Image (Current_Symbol.Symbol_Name);
    exception
        when others =>
            raise Error_Symbol_Index;
    end Get_Indexed_Symbol_Name;

    function Get_Indexed_Symbol_Type (I : Symbol_Index) return String is
    begin
        return Bounded_String.Image (Current_Symbol.Symbol_Type);
    exception
        when others =>
            raise Error_Symbol_Index;
    end Get_Indexed_Symbol_Type;

    procedure Get_Indexed_Symbol_Value
                 (I : Symbol_Index; F : in out Dynamic_Object.Dynamic_Object) is
    begin
        Dynamic_Object.Copy_Object (F, Current_Symbol.Symbol_Value);
    exception
        when others =>
            raise Error_Symbol_Index;
            raise Error_Symbol_Index;
    end Get_Indexed_Symbol_Value;

    function No_More_Symbols (I : Symbol_Index) return Boolean is
        More : Boolean := True;
    begin
        More := Symbols_Tree.More (I.Node);
        if More then
            return (False);
        end if;

        if (not More and not Lookahead) then
            Lookahead := True;
            return (False);
        elsif (not More and Lookahead) then
            return (True);
        end if;
    end No_More_Symbols;



end Symbols;

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=24 rec1=00 rec2=01 rec3=008
        [0x01] rec0=1b rec1=00 rec2=02 rec3=072
        [0x02] rec0=25 rec1=00 rec2=03 rec3=016
        [0x03] rec0=1b rec1=00 rec2=04 rec3=052
        [0x04] rec0=23 rec1=00 rec2=05 rec3=02a
        [0x05] rec0=27 rec1=00 rec2=06 rec3=006
        [0x06] rec0=1e rec1=00 rec2=07 rec3=036
        [0x07] rec0=09 rec1=00 rec2=08 rec3=000
    tail 0x2153c788e862656c83e5a 0x42a00088462060003