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

⟦05f6a7e42⟧ Ada Source

    Length: 18432 (0x4800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Find_Inline_Candidates, seg_004403

Derivation

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

E3 Source Code



with Profile;
with Log;
with Common;
with Lrm_Utilities;
with Add_Hyper_Table;
with Create_Null_Document;
with Simple_Status;
with Errors;
with Directory_Renames;
use Directory_Renames;
with Statement_Traversal;
with Declaration_Traversal;
with Lrm_Renames;
use Lrm_Renames;
package body Find_Inline_Candidates is

    procedure Stmt_Pre_Op (Program_Element :        Ada.Element;
                           Count           : in out Natural;
                           Control         : in out Ada.Traversal_Control) is
    begin
        Count   := Count + 1;
        Control := Ada.Continue;
    end Stmt_Pre_Op;

    procedure Post_Op (Program_Element :        Ada.Element;
                       Count           : in out Natural;
                       Control         : in out Ada.Traversal_Control) is
    begin
        Control := Ada.Continue;
    end Post_Op;

    procedure Count_Statements is new Statement_Traversal
                                         (Natural, Stmt_Pre_Op, Post_Op);

    function Count_Decls (For_Subprogram : Ada.Declaration) return Natural is
        Count       : Natural := 0;
        Local_Decls : Ada.Element_Iterator;

        procedure Count_Decls (In_Iter : in out Ada.Element_Iterator) is
            Decl         : Ada.Element;
            Nested_Decls : Ada.Element_Iterator;
        begin
            while not Ada.Done (In_Iter) loop
                Decl := Ada.Value (In_Iter);
                case Decls.Kind (Decl) is
                    when Decls.A_Package_Declaration =>
                        Nested_Decls := Decls.Visible_Part_Declarations (Decl);
                        Count_Decls (Nested_Decls);
                        Nested_Decls := Decls.Private_Part_Declarations (Decl);
                        Count_Decls (Nested_Decls);
                    when Decls.A_Package_Body_Declaration =>
                        Nested_Decls := Stmts.Declarative_Items
                                           (Decls.Package_Body_Block (Decl));
                        Count_Decls (Nested_Decls);
                    when Decls.A_Variable_Declaration |
                         Decls.A_Procedure_Declaration |
                         Decls.A_Function_Declaration |  
                         Decls.A_Task_Declaration |  
                         Decls.A_Package_Instantiation |
                         Decls.A_Procedure_Instantiation |
                         Decls.A_Function_Instantiation |
                         Decls.A_Procedure_Body_Declaration |
                         Decls.A_Function_Body_Declaration |
                         Decls.A_Task_Body_Declaration =>

                        -- These decls generate elaboration code and
                        -- are counted.  Nested decls are also counted.
                        Count := Count + 1;

                    when others =>
                        null;
                end case;
                Ada.Next (In_Iter);
            end loop;
        end Count_Decls;
    begin
        Local_Decls := Stmts.Declarative_Items
                          (Decls.Subprogram_Block (For_Subprogram));
        Count_Decls (Local_Decls);
        return Count;
    end Count_Decls;

    function Is_Subprogram_Body (Decl : Ada.Declaration) return Boolean is
    begin
        case Decls.Kind (Decl) is
            when Decls.A_Procedure_Body_Declaration |
                 Decls.A_Function_Body_Declaration =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Subprogram_Body;

    procedure Filter_Out_Body_Dependencies is
       new Ada.Filter (Is_Subprogram_Body);

    procedure Add (Units : String := "";
                   Max_Stmts : Positive := 5;
                   Max_Calls : Positive := 1000;
                   Max_Local_Variables_And_Subprograms : Positive := 10;
                   Max_Combo : Positive := 1000;
                   To_Document : in out Abstract_Document.Handle;
                   Response : String := "<PROFILE>") is

        Num_Statements  : Natural;
        Num_Local_Decls : Natural;
        Num_Calls       : Natural;
        The_Calls       : Ada.Element_List;

        Units_Iter : Object.Iterator := Naming.Resolution (Units);

        type Columns is (Statements, Local_Decls, Calls,  
                         Subprogram);

        function Is_Integer (C : Columns) return Boolean is
        begin
            case C is
                when Statements | Local_Decls | Calls =>
                    return True;
                when Subprogram =>
                    return False;
            end case;
        end Is_Integer;

        function Included (Elem : Ada.Element) return Boolean is
            The_Dependencies : Ada.Element_List;
            Control          : Ada.Traversal_Control := Ada.Continue;
        begin
            case Ada.Kind (Elem) is
                when Ada.A_Declaration =>
                    case Decls.Kind (Elem) is
                        when Decls.A_Procedure_Body_Declaration |
                             Decls.A_Function_Body_Declaration =>

                            Num_Statements := 0;
                            Count_Statements (Elem, Num_Statements, Control);

                            if Num_Statements <= Max_Stmts then

                                The_Dependencies := Ada.Usage (Elem);

                                Filter_Out_Body_Dependencies
                                   (The_Dependencies, The_Calls);

                                Num_Calls := Lrm_Utilities.Count (The_Calls);

                                if Num_Calls <= Max_Calls then

                                    Num_Local_Decls := Count_Decls (Elem);

                                    if Num_Local_Decls <=
                                       Max_Local_Variables_And_Subprograms then

                                        if (Num_Statements + Num_Local_Decls) *
                                           Num_Calls <= Max_Combo then
                                            return True;
                                        else
                                            return False;
                                        end if;

                                    else
                                        return False;
                                    end if;
                                else
                                    return False;
                                end if;

                            else
                                return False;
                            end if;
                        when others =>
                            return False;
                    end case;
                when others =>
                    return False;
            end case;
        end Included;

        function Explanation (C : Columns; Elem : Ada.Element) return String is
        begin
            case C is
                when Local_Decls =>
                    return "Number of local decls requiring elaboration";
                when Statements =>
                    return "Total number of statements in the subprogram body";
                when Calls =>
                    return "Total number of calls of the subprogram";
                when Subprogram =>
                    return "Subprogram Name";
            end case;
        end Explanation;

        function Image (C : Columns; Elem : Ada.Element) return String is
        begin
            case C is
                when Local_Decls =>
                    return Integer'Image (Num_Local_Decls);
                when Statements =>
                    return Integer'Image (Num_Statements);
                when Calls =>
                    return Integer'Image (Num_Calls);
                when Subprogram =>
                    return Decls.Name (Elem);
            end case;
        end Image;

        procedure Linkage (C                :     Columns;
                           For_Element      :     Ada.Element;
                           Linkage_Element  : out Ada.Element;
                           Linkage_Elements : out Ada.Element_List) is
            The_Decls : Ada.Element_Iterator;
            Decl      : Ada.Element;
        begin
            -- default values that are change within the case statement as
            -- necessary
            Linkage_Element  := Ada.Nil_Element;
            Linkage_Elements := Ada.Nil_List;

            case C is
                when Statements =>
                    -- first statement
                    Linkage_Element :=
                       Ada.Value (Stmts.Block_Body_Statements
                                     (Decls.Subprogram_Block (For_Element)));
                when Local_Decls =>
                    The_Decls := Stmts.Declarative_Items
                                    (Decls.Subprogram_Block (For_Element));
                    Linkage_Element := Ada.Nil_Element;
                    while not Ada.Done (The_Decls) loop
                        Decl := Ada.Value (The_Decls);
                        case Decls.Kind (Decl) is
                            when Decls.A_Package_Declaration |
                                 Decls.A_Package_Body_Declaration |
                                 Decls.A_Variable_Declaration |
                                 Decls.A_Procedure_Declaration |
                                 Decls.A_Procedure_Body_Declaration |
                                 Decls.A_Function_Declaration |
                                 Decls.A_Function_Body_Declaration |
                                 Decls.A_Task_Declaration |
                                 Decls.A_Task_Body_Declaration |
                                 Decls.A_Package_Instantiation |
                                 Decls.A_Procedure_Instantiation |
                                 Decls.A_Function_Instantiation =>

                                -- first real declaration
                                Linkage_Element := Decl;
                                return;
                            when others =>
                                null;
                        end case;  
                        Ada.Next (The_Decls);
                    end loop;
                    Linkage_Element := Ada.Nil_Element;
                when Calls =>
                    Linkage_Elements := The_Calls;
                when Subprogram =>
                    Linkage_Element := For_Element;

            end case;
        end Linkage;

        procedure Add_Hyper_Table_To_Doc is
           new Add_Hyper_Table (Included,  
                                Columns,  
                                Is_Integer, Image, Explanation, Linkage,  
                                Table_Title => "INLINE CANDIDATE PROCEDURES");

    begin
        if Object.Is_Bad (Units_Iter) then
            Log.Put_Line (Units & " is not a valid pathname",
                          Profile.Error_Msg);
        else
            Add_Hyper_Table_To_Doc (Units_Iter, To_Document);
        end if;
    end Add;

    procedure Display (Units : String := "";
                       Max_Stmts : Positive := 5;
                       Max_Calls : Positive := 1000;
                       Max_Local_Variables_And_Subprograms : Positive := 10;
                       Max_Combo : Positive := 1000;
                       To_Preview_Object : String := "Inline_Info";
                       Response : String := "<PROFILE>") is

        Document  : Abstract_Document.Handle;
        Condition : Errors.Condition;
    begin
        Create_Null_Document (Named           => To_Preview_Object,
                              Error_Info      => Condition,
                              Document_Handle => Document);

        case Errors.Severity (Condition) is
            when Simple_Status.Problem | Simple_Status.Fatal =>
                Log.Put_Line ("Problem creating object " & To_Preview_Object &
                              ".  " & Errors.Info (Condition),
                              Profile.Error_Msg);
            when others =>

                Add (Units, Max_Stmts, Max_Calls,
                     Max_Local_Variables_And_Subprograms,
                     Max_Combo, Document, Response);

                Abstract_Document.Close (Document);
                Common.Definition (To_Preview_Object);
        end case;
    end Display;

end Find_Inline_Candidates;

E3 Meta Data

    nblk1=11
    nid=0
    hdr6=22
        [0x00] rec0=22 rec1=00 rec2=01 rec3=032
        [0x01] rec0=00 rec1=00 rec2=11 rec3=004
        [0x02] rec0=14 rec1=00 rec2=02 rec3=020
        [0x03] rec0=00 rec1=00 rec2=10 rec3=01c
        [0x04] rec0=14 rec1=00 rec2=03 rec3=026
        [0x05] rec0=1c rec1=00 rec2=04 rec3=040
        [0x06] rec0=1c rec1=00 rec2=05 rec3=00a
        [0x07] rec0=00 rec1=00 rec2=0e rec3=02c
        [0x08] rec0=17 rec1=00 rec2=06 rec3=090
        [0x09] rec0=19 rec1=00 rec2=07 rec3=024
        [0x0a] rec0=19 rec1=00 rec2=08 rec3=010
        [0x0b] rec0=17 rec1=00 rec2=09 rec3=040
        [0x0c] rec0=00 rec1=00 rec2=0f rec3=006
        [0x0d] rec0=10 rec1=00 rec2=0a rec3=062
        [0x0e] rec0=18 rec1=00 rec2=0b rec3=08c
        [0x0f] rec0=18 rec1=00 rec2=0c rec3=062
        [0x10] rec0=14 rec1=00 rec2=0d rec3=000
    tail 0x21500335a815c6381e899 0x42a00088462061e03