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

⟦0ab9c6930⟧ Ada Source

    Length: 24576 (0x6000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Interface_Analysis, seg_020bcf

Derivation

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

with Lrm_Utilities;
with Compilation_Units;
with Type_Information;
package body Interface_Analysis is

    procedure Analyze (Declarations_In_Package : String := "<SELECTION>";
                       Db : in out Database) is

        Comp_Unit : Ada_Program.Compilation_Unit :=
           Compilation_Units.Parent_Compilation_Unit
              (Ada_Program.Conversion.Resolve (Declarations_In_Package));

        Decls : Ada_Program.Element_Iterator :=
           Declarations.Visible_Part_Declarations (Comp_Unit);

        A_Decl         : Ada_Program.Declaration;  
        A_Global_State : Global_State := False;

        Sub_Iter   : Subprogram_Iterator;
        Param_Iter : Parameter_Iterator;

    begin
        Rpc_Decls.Initialize (Db.Decls);
        Unique_Types.Initialize (Db.Types);

        while not Ada_Program.Done (Decls) loop
            A_Decl := Ada_Program.Value (Decls);

            case Declarations.Kind (A_Decl) is
                when Declarations.A_Function_Declaration |
                     Declarations.A_Procedure_Declaration |
                     Declarations.An_Exception_Declaration =>

                    Rpc_Decls.Add (The_Declaration => A_Decl,
                                   To              => Db.Decls,
                                   Global          => A_Global_State);

                when others =>
                    null;
            end case;

            Ada_Program.Next (Decls);
        end loop;

        Init (Db, Sub_Iter);

        while not Done (Sub_Iter) loop

            if Kind (Sub_Iter) = A_Function then
                Unique_Types.Add
                   (The_Declaration => Return_Type_Decl (Iter => Sub_Iter),
                    To              => Db.Types,
                    Global          => A_Global_State);
            end if;

            Param_Iter := Parameters (Sub_Iter);
            while not Done (Param_Iter) loop
                Unique_Types.Add
                   (The_Declaration =>
                       Declarations.Enclosing_Declaration
                          (Element => Type_Information.Base_Type
                                         (Type_Def =>
                                             Declarations.Type_Specification
                                                (Type_Declaration_Or_Id =>
                                                    Formals_Type_Decl
                                                       (Iter => Param_Iter)))),
                    To              => Db.Types,
                    Global          => A_Global_State);

                Next (Param_Iter);
            end loop;

            Next (Sub_Iter);
        end loop;

    end Analyze;
    procedure Add_Other_Exceptions
                 (Declaration_List :        String := ">>WILDCARD REFERENCE<<";
                  Db               : in out Database) is

        Decls : Ada_Program.Element_List :=
           Ada_Program.Conversion.Resolve
              (Declaration_List, Look_Through_Stubs => False);

        A_Decl         : Ada_Program.Declaration;
        A_Global_State : Global_State := False;

    begin

        while not Ada_Program.Done (Decls) loop
            A_Decl := Declarations.Enclosing_Declaration
                         (Ada_Program.Value (Decls));

            if not Declarations.Is_In_Private_Part (A_Decl) then
                case Declarations.Kind (A_Decl) is
                    when Declarations.An_Exception_Declaration =>

                        Rpc_Decls.Add (The_Declaration => A_Decl,
                                       To              => Db.Decls,
                                       Global          => A_Global_State);

                    when others =>
                        null;
                end case;

            end if;
            Ada_Program.Next (Decls);
        end loop;

    end Add_Other_Exceptions;

    procedure Init (From_Db : Database; Iter : in out Reference_Iterator) is
    begin
        Rpc_Decls.Init (From_Db.Decls, Iter.Decl_Iter);
        Unique_Types.Init (From_Db.Types, Iter.Types_Iter);

    end Init;

    function Done (Iter : Reference_Iterator) return Boolean is
    begin
        return Rpc_Decls.Done (Iter.Decl_Iter) and then
                  Unique_Types.Done (Iter.Types_Iter);
    end Done;

    function Referenced_Unit (Iter : Reference_Iterator)
                             return Ada_Program.Compilation_Unit is
    begin
        if not Rpc_Decls.Done (Iter.Decl_Iter) then
            return Rpc_Decls.Parent (Iter.Decl_Iter);
        else
            return Unique_Types.Parent (Iter.Types_Iter);
        end if;

    end Referenced_Unit;

    function Reference (Iter : Reference_Iterator) return String is
    begin
        if not Rpc_Decls.Done (Iter.Decl_Iter) then
            return Rpc_Decls.Simple_Name (Iter.Decl_Iter);
        else
            return Unique_Types.Simple_Name (Iter.Types_Iter);
        end if;
    end Reference;

    procedure Next (Iter : in out Reference_Iterator) is
    begin
        if not Rpc_Decls.Done (Iter.Decl_Iter) then
            Rpc_Decls.Next (Iter.Decl_Iter);

        else
            Unique_Types.Next (Iter.Types_Iter);
        end if;
    end Next;

    function Done (Iter : Id_Iterator) return Boolean is
    begin
        return Ada_Program.Done (Ada_Program.Element_List (Iter));
    end Done;

    function Reference (Iter : Id_Iterator) return String is
    begin
        return Lrm_Utilities.Qualified_Reference
                  (Ada_Program.Value (Ada_Program.Element_List (Iter)));
    end Reference;

    function Name (Iter : Id_Iterator) return String is
    begin
        return Declarations.Name (Ada_Program.Value
                                     (Ada_Program.Element_List (Iter)));
    end Name;

    procedure Next (Iter : in out Id_Iterator) is
    begin
        Ada_Program.Next (Ada_Program.Element_List (Iter));
    end Next;

    procedure Init (From_Db : Database; Iter : in out Exception_Iterator) is
        State : Decl_State;
    begin
        Rpc_Decls.Init (From_Db.Decls, Rpc_Decls.Declaration_Iterator (Iter));
        State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
        case State.Kind is
            when An_Exception =>
                null;
            when A_Procedure | A_Function =>
                Next (Iter);
        end case;
    end Init;

    function Done (Iter : Exception_Iterator) return Boolean is
        Local : Exception_Iterator := Iter;
        State : Decl_State;
    begin
        if Rpc_Decls.Done (Rpc_Decls.Declaration_Iterator (Iter)) then
            return True;
        else
            State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
            case State.Kind is               when An_Exception =>
                    return False;
                when A_Procedure | A_Function =>
                    Next (Local);
            end case;
            return Rpc_Decls.Done (Rpc_Decls.Declaration_Iterator (Local));
        end if;
    end Done;

    function Names (Iter : Exception_Iterator) return Id_Iterator is
        The_Decl : Ada_Program.Element      :=
           Rpc_Decls.Declaration (Rpc_Decls.Declaration_Iterator (Iter));
        Id_List  : Ada_Program.Element_List :=
           Declarations.Identifiers (The_Decl);
    begin
        return Id_Iterator (Id_List);
    end Names;

    function Unique_Name (Iter : Exception_Iterator) return String is
    begin
        return Rpc_Decls.Unique_Simple_Name
                  (Rpc_Decls.Declaration_Iterator (Iter));
    end Unique_Name;

    function Reference (Iter : Exception_Iterator) return String is
    begin
        return Lrm_Utilities.Qualified_Reference
                  (Rpc_Decls.Declaration
                      (Rpc_Decls.Declaration_Iterator (Iter)));
    end Reference;

    procedure Next (Iter : in out Exception_Iterator) is
        State : Decl_State;
    begin
        Rpc_Decls.Next (Rpc_Decls.Declaration_Iterator (Iter));
        while not Rpc_Decls.Done (Rpc_Decls.Declaration_Iterator (Iter)) loop

            State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
            case State.Kind is
                when An_Exception =>
                    exit;
                when A_Procedure | A_Function =>
                    null;
            end case;
            Rpc_Decls.Next (Rpc_Decls.Declaration_Iterator (Iter));
        end loop;
    end Next;

    function Name (Of_Type : Type_Decl) return String is
    begin
        return Declarations.Name (Of_Type);
    end Name;

    function Kind (Of_Type : Type_Decl) return Type_Kind is
    begin
        return Type_Information.Kind (Declarations.Object_Type (Of_Type));
    end Kind;

    function Done (Iter : Parameter_Iterator) return Boolean is
    begin
        return Ada_Program.Done (Ada_Program.Element_Iterator (Iter));
    end Done;

    function Names (Iter : Parameter_Iterator) return Id_Iterator is
    begin  
        return Id_Iterator (Declarations.Identifiers
                               (Ada_Program.Value
                                   (Ada_Program.Element_Iterator (Iter))));
    end Names;

    function Formals_Image (Iter : Parameter_Iterator) return String is
    begin  
        return Declarations.Name (Ada_Program.Value
                                     (Ada_Program.Element_Iterator (Iter)));
    end Formals_Image;

    function Formals_Type_Decl (Iter : Parameter_Iterator) return Type_Decl is
        Param    : Ada_Program.Element;
        Type_Def : Ada_Program.Element;
    begin
        Param    := Ada_Program.Value (Ada_Program.Element_Iterator (Iter));
        Type_Def := Declarations.Type_Mark (Param);
        return Declarations.Enclosing_Declaration
                  (Ada_Program.Definition (Type_Def));
    end Formals_Type_Decl;

    function Mode (Iter : Parameter_Iterator) return Parameter_Mode is
    begin
        return Declarations.Subprogram_Parameter_Kind
                  (Ada_Program.Value (Ada_Program.Element_Iterator (Iter)));
    end Mode;

    function Initial_Expression (Iter : Parameter_Iterator) return String is
        Value : Ada_Program.Element :=
           Declarations.Initial_Value
              (Ada_Program.Value (Ada_Program.Element_Iterator (Iter)));
    begin
        if Ada_Program.Is_Nil (Value) then
            return "";
        else
            return Ada_Program.Image (Value);
        end if;

    end Initial_Expression;
    function Image (Iter : Parameter_Iterator) return String is
    begin
        return Ada_Program.Image (Ada_Program.Value
                                     (Ada_Program.Element_Iterator (Iter)));
    end Image;
    procedure Next (Iter : in out Parameter_Iterator) is
    begin
        Ada_Program.Next (Ada_Program.Element_Iterator (Iter));
    end Next;


    procedure Init (From_Db : Database; Iter : in out Subprogram_Iterator) is
        State : Decl_State;
    begin
        Rpc_Decls.Init (From_Db.Decls, Rpc_Decls.Declaration_Iterator (Iter));
        State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
        case State.Kind is
            when An_Exception =>
                Next (Iter);
            when A_Procedure | A_Function =>
                null;
        end case;
    end Init;

    function Done (Iter : Subprogram_Iterator) return Boolean is
        Local : Subprogram_Iterator := Iter;
        State : Decl_State;
    begin
        if Rpc_Decls.Done (Rpc_Decls.Declaration_Iterator (Iter)) then
            return True;
        else
            State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
            case State.Kind is
                when An_Exception =>
                    Next (Local);
                when A_Procedure | A_Function =>
                    return False;
            end case;
            return Rpc_Decls.Done (Rpc_Decls.Declaration_Iterator (Local));
        end if;
    end Done;

    function Name (Iter : Subprogram_Iterator) return String is
    begin
        return Rpc_Decls.Simple_Name (Rpc_Decls.Declaration_Iterator (Iter));

    end Name;

    function Unique_Name (Iter : Subprogram_Iterator) return String is
    begin
        return Rpc_Decls.Unique_Simple_Name
                  (Rpc_Decls.Declaration_Iterator (Iter));

    end Unique_Name;

    function Reference (Iter : Subprogram_Iterator) return String is
    begin
        return Lrm_Utilities.Qualified_Reference
                  (Rpc_Decls.Declaration
                      (Rpc_Decls.Declaration_Iterator (Iter)));

    end Reference;

    function Kind (Iter : Subprogram_Iterator) return Subprogram_Kind is
        State : Decl_State;
    begin
        State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
        case State.Kind is
            when An_Exception =>
                raise Program_Error;
            when A_Function =>
                return A_Function;
            when A_Procedure =>
                return A_Procedure;
        end case;
    end Kind;

    function Return_Type_Decl (Iter : Subprogram_Iterator) return Type_Decl is
        State : Decl_State;
    begin
        State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
        case State.Kind is
            when An_Exception =>
                raise Program_Error;
            when A_Function =>
                return State.Return_Type;
            when A_Procedure =>
                raise Program_Error;
        end case;
    end Return_Type_Decl;

    function Parameters (Iter : Subprogram_Iterator)
                        return Parameter_Iterator is
        State : Decl_State;
    begin
        State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
        return State.Parameters;
    end Parameters;

    procedure Next (Iter : in out Subprogram_Iterator) is
        State : Decl_State;
    begin
        Rpc_Decls.Next (Rpc_Decls.Declaration_Iterator (Iter));
        while not Rpc_Decls.Done (Rpc_Decls.Declaration_Iterator (Iter)) loop

            State := Rpc_Decls.Analysis (Rpc_Decls.Declaration_Iterator (Iter));
            case State.Kind is
                when A_Procedure | A_Function =>
                    exit;
                when An_Exception =>
                    null;
            end case;
            Rpc_Decls.Next (Rpc_Decls.Declaration_Iterator (Iter));
        end loop;
    end Next;

    procedure Init (From_Db : Database; Iter : in out Unique_Type_Iterator) is
    begin
        Unique_Types.Init (From_Db.Types,
                           Unique_Types.Declaration_Iterator (Iter));
    end Init;

    function Done (Iter : Unique_Type_Iterator) return Boolean is
    begin
        return Unique_Types.Done (Unique_Types.Declaration_Iterator (Iter));

    end Done;

    function Name (Iter : Unique_Type_Iterator) return String is
    begin
        return Unique_Types.Simple_Name
                  (Unique_Types.Declaration_Iterator (Iter));

    end Name;

    function Decl (Iter : Unique_Type_Iterator) return Type_Decl is
    begin
        return Unique_Types.Declaration
                  (Unique_Types.Declaration_Iterator (Iter));

    end Decl;

    function Kind (Iter : Unique_Type_Iterator) return Type_Kind is
    begin
        return Unique_Types.Analysis (Unique_Types.Declaration_Iterator (Iter)).
                  Kind;
    end Kind;

    function Reference (Iter : Unique_Type_Iterator) return String is
        Is_In_Standard : Boolean :=
           Unique_Types.Analysis (Unique_Types.Declaration_Iterator (Iter)).
              Is_Standard;
    begin
        if Is_In_Standard then
            return Unique_Types.Simple_Name
                      (Unique_Types.Declaration_Iterator (Iter));
        else
            return Lrm_Utilities.Qualified_Reference
                      (Unique_Types.Declaration
                          (Unique_Types.Declaration_Iterator (Iter)));

        end if;
    end Reference;
    procedure Next (Iter : in out Unique_Type_Iterator) is
    begin
        Unique_Types.Next (Unique_Types.Declaration_Iterator (Iter));

    end Next;

    procedure Update_State (Decl   :        Ada_Program.Declaration;
                            S      : in out Decl_State;
                            Global : in out Global_State) is
    begin
        case Declarations.Kind (Decl) is
            when Declarations.A_Procedure_Declaration =>
                S.Kind        := A_Procedure;
                S.Parameters  := Parameter_Iterator
                                    (Declarations.Subprogram_Parameters (Decl));
                S.Return_Type := Ada_Program.Nil_Element;

            when Declarations.A_Function_Declaration =>
                S.Kind        := A_Function;
                S.Parameters  := Parameter_Iterator
                                    (Declarations.Subprogram_Parameters (Decl));
                S.Return_Type := Ada_Program.Parent
                                    (Ada_Program.Definition
                                        (Declarations.Return_Type (Decl)));

                S.Return_Type_Kind :=
                   Type_Information.Kind
                      (Declarations.Type_Specification (S.Return_Type));
            when Declarations.An_Exception_Declaration =>
                S.Kind := An_Exception;
            when others =>
                null;
        end case;
    end Update_State;

    procedure Update_State (Decl   :        Ada_Program.Declaration;
                            S      : in out Type_State;
                            Global : in out Global_State) is
        Type_Def : Declarations.Type_Definition :=
           Declarations.Type_Specification (Decl);
    begin
        S.Is_Standard := Type_Information.Is_Predefined (Type_Def);
        S.Kind        := Type_Information.Kind (Type_Def);
    end Update_State;

    function Reference (Of_Type : Type_Decl) return String is
    begin
        return Lrm_Utilities.Qualified_Reference (Of_Type);
    end Reference;
end Interface_Analysis;

    nblk1=17
    nid=0
    hdr6=2e
        [0x00] rec0=1f rec1=00 rec2=01 rec3=018
        [0x01] rec0=00 rec1=00 rec2=17 rec3=014
        [0x02] rec0=1c rec1=00 rec2=02 rec3=024
        [0x03] rec0=17 rec1=00 rec2=03 rec3=048
        [0x04] rec0=1d rec1=00 rec2=04 rec3=01a
        [0x05] rec0=00 rec1=00 rec2=16 rec3=010
        [0x06] rec0=1d rec1=00 rec2=05 rec3=05a
        [0x07] rec0=20 rec1=00 rec2=06 rec3=000
        [0x08] rec0=1c rec1=00 rec2=07 rec3=002
        [0x09] rec0=1a rec1=00 rec2=08 rec3=060
        [0x0a] rec0=01 rec1=00 rec2=15 rec3=00c
        [0x0b] rec0=1c rec1=00 rec2=09 rec3=046
        [0x0c] rec0=19 rec1=00 rec2=0a rec3=08c
        [0x0d] rec0=00 rec1=00 rec2=14 rec3=00c
        [0x0e] rec0=1b rec1=00 rec2=0b rec3=028
        [0x0f] rec0=1c rec1=00 rec2=0c rec3=030
        [0x10] rec0=1c rec1=00 rec2=0d rec3=05c
        [0x11] rec0=1e rec1=00 rec2=0e rec3=01e
        [0x12] rec0=1b rec1=00 rec2=0f rec3=080
        [0x13] rec0=20 rec1=00 rec2=10 rec3=05a
        [0x14] rec0=1a rec1=00 rec2=11 rec3=048
        [0x15] rec0=14 rec1=00 rec2=12 rec3=024
        [0x16] rec0=13 rec1=00 rec2=13 rec3=000
    tail 0x2171d3044838d455bd344 0x42a00088462061e03