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

⟦6748ff839⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Pre_Op, seg_0043e2, separate Call_Tree_Queues

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 Diana;
with Debug_Tools;
separate (Call_Tree_Queues)
procedure Pre_Op (Program_Element :        Ap.Element;
                  State           : in out State_Record;
                  Control         : in out Ap.Traversal_Control) is

    function "=" (L, R : Diana.Node_Name) return Boolean renames Diana."=";


begin

    Control := Ap.Continue;


    -- Suppress parsing of Parameters when we come to them in the Diana
    -- The are handled before the procedure/function call
    if Diana.Kind (Conv.Convert (Program_Element)) = Diana.Dn_Param_Assoc_S then
        Control := Ap.Abandon_Children;

    else

        begin
            case Ap.Kind (Program_Element => Program_Element) is

                when Ap.A_Declaration =>

                    case Decl.Kind (A_Declaration => Program_Element) is

                        when Decl.A_Procedure_Body_Declaration |
                             Decl.A_Function_Body_Declaration =>

                            -- Walk declaration block, ignoring subprogram
                            -- bodies.
                            declare
                                Iter : Ap.Element_Iterator :=
                                   Stmt.Declarative_Items
                                      (Block_Statement =>
                                          Decl.Subprogram_Block
                                             (Subprogram_Body =>
                                                 Program_Element));
                            begin
                                while not Ap.Done (Iter) loop
                                    declare
                                        Elem : Ap.Element := Ap.Value (Iter);
                                    begin
                                        if Decl.Kind (Elem) /=
                                           Decl.Not_A_Declaration then
                                            if (not Decl.Is_Procedure                                                      (Elem)) and
                                               (not Decl.Is_Function
                                                       (Elem)) then
                Construct_Call_Tree (Root_Element        => Ap.Value ((Iter)),
                                     State               => State,
                                     Major_Elements_Only => False);
                                            end if;
                                        end if;
                                    end;
                                    Ap.Next (Iter);
                                end loop;
                            end;


                            -- Walk statement block statements.
                            Call_Tree_For_Iterator
                               (Stmt.Block_Body_Statements
                                   (Block_Statement =>
                                       Decl.Subprogram_Block
                                          (Subprogram_Body => Program_Element)),
                                State);


                            -- Walk exception handler
                            declare
                                Exception_Arms : Ap.Element_Iterator :=
                                   Stmt.Block_Exception_Handler_Arms
                                      (Block_Statement =>
                                          Decl.Subprogram_Block
                                             (Subprogram_Body =>
                                                 Program_Element));
                            begin
                                while not Ap.Done (Exception_Arms) loop

                                    Call_Tree_For_Iterator
                                       (Iter      =>
                                           Stmt.Handler_Statements
                                              (Exception_Arm =>
                                                  Ap.Value (Exception_Arms)),
                                        The_State => State);
                                    Ap.Next (Exception_Arms);
                                end loop;
                            end;

                            Control := Ap.Terminate_Immediately;

                        when others =>
                            null;
                    end case;


                when Ap.A_Statement =>

                    case Stmt.Kind (A_Statement => Program_Element) is

                        when Stmt.A_Procedure_Call_Statement =>

                            -- traverse all parameters first
                            Call_Tree_For_Iterator
                               (Iter => Stmt.Procedure_Call_Parameters
                                           (Procedure_Or_Entry_Call_Statement =>
                                               Program_Element,
                                            Normalized => True),
                                The_State => State);


                            -- Add call and process the calling subprogram if
                            -- we haven't processed it before.
                            Recurse_Through_Subprogram
                               (Called_Subprogram_Decl =>
                                   Stmt.Called_Procedure
                                      (Procedure_Or_Entry_Call_Statement =>
                                          Program_Element),
                                The_State              => State);
                        when others =>
                            null;
                    end case;

                when Ap.Not_A_Major_Element =>

                    case Expr.Kind (Program_Element) is

                        when Expr.A_Function_Call =>

                            -- iterate through all function parameters
                            Call_Tree_For_Iterator
                               (Iter => Expr.Function_Call_Parameters
                                           (A_Function_Call => Program_Element,
                                            Normalized      => True),
                                The_State => State);

                            if not Expr.Is_Predefined (Program_Element) then


                                Recurse_Through_Subprogram
                                   (Called_Subprogram_Decl =>
                                       Expr.Called_Function
                                          (A_Function_Call => Program_Element),
                                    The_State              => State);
                            end if;
                        when others =>
                            null;
                    end case;
                when others =>
                    null;
            end case;
        end;
    end if;
end Pre_Op;

E3 Meta Data

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=22 rec1=00 rec2=01 rec3=00e
        [0x01] rec0=11 rec1=00 rec2=02 rec3=002
        [0x02] rec0=13 rec1=00 rec2=03 rec3=004
        [0x03] rec0=13 rec1=00 rec2=04 rec3=02c
        [0x04] rec0=18 rec1=00 rec2=05 rec3=04c
        [0x05] rec0=17 rec1=00 rec2=06 rec3=054
        [0x06] rec0=18 rec1=00 rec2=07 rec3=000
    tail 0x215003128815c6343c8b2 0x42a00088462061e03