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

⟦8122ed20c⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Declaration_Table, seg_004620

Derivation

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

with String_Utilities;
with Compilation_Units;
with Declarations;
package body Declaration_Table is


    Mult_Op     : constant String := """*""";
    Equality_Op : constant String := """=""";
    Plus_Op     : constant String := """+""";
    Minus_Op    : constant String := """-""";

    procedure Initialize (Db : in out Database) is
    begin
        Decl_Map.Initialize (Db.Decls);
        Simple_Name_Map.Initialize (Db.Simple_Names);
        Parent_Map.Initialize (Db.Parents);
    end Initialize;

    function Get_Name (Decl : Ada_Program.Declaration) return String is
        Simple_Name : constant String := Declarations.Name (Decl);
    begin
        if Declarations.Is_Function (Decl) and then
           Declarations.Is_Operator_Definition (Decl) then
            if String_Utilities.Equal (Simple_Name, Mult_Op) then
                return "Mult_Op";
            elsif String_Utilities.Equal (Simple_Name, Equality_Op) then
                return "Equality_Op";
            elsif String_Utilities.Equal (Simple_Name, Plus_Op) then
                return "Plus_Op";
            elsif String_Utilities.Equal (Simple_Name, Minus_Op) then
                return "Minus_Op";
            else
                raise Program_Error;
            end if;
        else
            return Simple_Name;
        end if;
    end Get_Name;

    procedure Add (The_Declaration :        Ada_Program.Declaration;  
                   To              : in out Database;
                   Global          : in out Global_State) is
        Info : Decl_Info;
        Id : Long_Integer := Ada_Program.Conversion.Unique_Id (The_Declaration);
    begin
        begin
            Info := Decl_Map.Eval (To.Decls, Id);
            Update_State (The_Declaration, Info.Analysis_State, Global);
            Decl_Map.Define (To.Decls, Id, Info, False);
        exception
            when Decl_Map.Undefined =>
                To.Last_Decl_Number := To.Last_Decl_Number + 1;
                Info.Decl_Number    := To.Last_Decl_Number;
                Info.Decl           := The_Declaration;
                Info.Parent         := Compilation_Units.Parent_Compilation_Unit
                                          (The_Declaration);
                Update_State (The_Declaration, Info.Analysis_State, Global);
        end;

        declare
            Name_Instance : Natural;  
            Simple_Name   : constant String := Get_Name (The_Declaration);
        begin
            Name_Instance      := Simple_Name_Map.Eval
                                     (To.Simple_Names, Simple_Name);
            Info.Is_Overloaded := True;

            Unbounded.Copy (Info.Unique_Simple_Name,
                            Simple_Name & "_" &
                               String_Utilities.Strip
                                  (Natural'Image (Name_Instance + 1)));
            Simple_Name_Map.Define
               (To.Simple_Names, Simple_Name, Name_Instance + 1);
        exception
            when Simple_Name_Map.Undefined =>
                Simple_Name_Map.Define (To.Simple_Names, Simple_Name, 1);
                Unbounded.Copy (Info.Unique_Simple_Name, Simple_Name);
        end;

        Decl_Map.Define (To.Decls, Id, Info, False);

        begin
            if not (String_Utilities.Equal
                       ("Standard", Declarations.Name
                                       (Compilation_Units.Unit_Declaration
                                           (Info.Parent)))) then
                Parent_Map.Define
                   (To.Parents, Ada_Program.Conversion.Unique_Id (Info.Parent),
                    Info.Parent, True);
            end if;
        exception
            when Parent_Map.Multiply_Defined =>
                null;
        end;
    end Add;

    function Max (Left, Right : Natural) return Natural is
    begin
        if Left > Right then
            return Left;
        else
            return Right;
        end if;
    end Max;

    procedure Init (From_Db : Database; Iter : in out Declaration_Iterator) is
        Map_Iter : Decl_Map.Iterator;
        Info     : Decl_Info;
    begin
        Decl_Map.Init (Map_Iter, From_Db.Decls);
        while not Decl_Map.Done (Map_Iter) loop
            Info := Decl_Map.Eval (From_Db.Decls, Decl_Map.Value (Map_Iter));

            Iter.Data (Info.Decl_Number) := Info;
            Iter.Size := Max (Iter.Size, Info.Decl_Number);
            Decl_Map.Next (Map_Iter);
        end loop;
        Iter.Current := 1;
    end Init;

    function Done (Iter : Declaration_Iterator) return Boolean is
    begin
        return Iter.Current > Iter.Size;
    end Done;

    function Declaration (Iter : Declaration_Iterator)
                         return Ada_Program.Element is  
    begin
        return Iter.Data (Iter.Current).Decl;
    end Declaration;

    function Analysis (Iter : Declaration_Iterator) return Declaration_State is
    begin
        return Iter.Data (Iter.Current).Analysis_State;
    end Analysis;

    function Simple_Name (Iter : Declaration_Iterator) return String is
    begin
        return Declarations.Name (Declaration (Iter));
    end Simple_Name;

    function Is_Overloaded (Iter : Declaration_Iterator) return Boolean is
    begin
        return Iter.Data (Iter.Current).Is_Overloaded;
    end Is_Overloaded;

    function Unique_Simple_Name (Iter : Declaration_Iterator) return String is
    begin
        return Unbounded.Image (Iter.Data (Iter.Current).Unique_Simple_Name);
    end Unique_Simple_Name;

    procedure Next (Iter : in out Declaration_Iterator) is
    begin
        Iter.Current := Iter.Current + 1;
    end Next;

    procedure Init (From_Db :        Database;
                    Iter    : in out Parent_Comp_Unit_Iterator) is
    begin
        Iter := Parent_Comp_Unit_Iterator (From_Db);
        Parent_Map.Init (Iter.Parent_Iter, From_Db.Parents);
    end Init;

    function Done (Iter : Parent_Comp_Unit_Iterator) return Boolean is
    begin
        return Parent_Map.Done (Iter.Parent_Iter);

    end Done;

    function Parent (Iter : Parent_Comp_Unit_Iterator)
                    return Ada_Program.Compilation_Unit is
    begin
        return Parent_Map.Eval (Iter.Parents,
                                Parent_Map.Value (Iter.Parent_Iter));
    end Parent;

    function Simple_Name (Iter : Parent_Comp_Unit_Iterator) return String is
    begin
        return Declarations.Name
                  (Compilation_Units.Unit_Declaration
                      (Parent_Map.Eval (Iter.Parents,
                                        Parent_Map.Value (Iter.Parent_Iter))));
    end Simple_Name;

    procedure Next (Iter : in out Parent_Comp_Unit_Iterator) is
    begin
        Parent_Map.Next (Iter.Parent_Iter);
    end Next;

    function Hash (Key : Long_Integer) return Integer is
    begin
        return Integer (Key mod Long_Integer (Integer'Last));
    end Hash;
end Declaration_Table;

    nblk1=b
    nid=0
    hdr6=16
        [0x00] rec0=1c rec1=00 rec2=01 rec3=02c
        [0x01] rec0=00 rec1=00 rec2=0b rec3=016
        [0x02] rec0=19 rec1=00 rec2=02 rec3=05c
        [0x03] rec0=15 rec1=00 rec2=03 rec3=04a
        [0x04] rec0=01 rec1=00 rec2=0a rec3=014
        [0x05] rec0=1c rec1=00 rec2=04 rec3=024
        [0x06] rec0=1e rec1=00 rec2=05 rec3=070
        [0x07] rec0=00 rec1=00 rec2=09 rec3=008
        [0x08] rec0=1d rec1=00 rec2=06 rec3=040
        [0x09] rec0=1d rec1=00 rec2=07 rec3=05e
        [0x0a] rec0=05 rec1=00 rec2=08 rec3=000
    tail 0x217002464815c65d474c4 0x42a00088462061e03