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

⟦88766a40b⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body With_Accounting, seg_00463b

Derivation

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

with Declarations;
with Ada_Program;
with Bounded_String;
with Compilation_Units;
package body With_Accounting is

    package Ada renames Ada_Program;

    function "=" (Left, Right : Compilation_Units.Context_Clause_Kinds)
                 return Boolean renames Compilation_Units."=";

    function Number_Of_Withs (Comp_Unit : Ada_Program.Element) return Natural is
        Context_Clauses  : Ada_Program.Element_Iterator :=
           Compilation_Units.Context_Clause_Elements (Comp_Unit);
        Clause           : Ada_Program.Element;
        Referenced_Units : Ada.Element_Iterator;

        Count : Natural := 0;
    begin
        while not Ada.Done (Context_Clauses) loop
            Clause := Ada.Value (Context_Clauses);

            case Compilation_Units.Context_Clause_Kind (Clause) is
                when Compilation_Units.A_With_Clause =>
                    Referenced_Units :=
                       Compilation_Units.Referenced_Units (Clause);

                    while not Ada.Done (Referenced_Units) loop
                        Count := Count + 1;
                        Ada.Next (Referenced_Units);
                    end loop;
                when others =>
                    null;
            end case;

            Ada.Next (Context_Clauses);
        end loop;

        return Count;
    end Number_Of_Withs;

    procedure Initialize (Comp_Unit :        Ada_Program.Element;
                          Db        : in out Database) is

        Context_Clauses  : Ada_Program.Element_Iterator :=
           Compilation_Units.Context_Clause_Elements (Comp_Unit);
        Clause           : Ada_Program.Element;
        Referenced_Units : Ada.Element_Iterator;

        Remote_Compilation_Unit : Ada_Program.Compilation_Unit;

        Count     : Positive := 1;
        Data_Item : Data;
    begin
        while not Ada.Done (Context_Clauses) loop
            Clause := Ada.Value (Context_Clauses);

            case Compilation_Units.Context_Clause_Kind (Clause) is
                when Compilation_Units.A_With_Clause =>
                    Referenced_Units :=
                       Compilation_Units.Referenced_Units (Clause);

                    while not Ada.Done (Referenced_Units) loop

                        Remote_Compilation_Unit :=
                           Compilation_Units.Parent_Compilation_Unit
                              (Ada.Definition (Ada.Value (Referenced_Units)));

                        Data_Item.Comp_Unit := Remote_Compilation_Unit;
                        Data_Item.With_Id   := Ada.Value (Referenced_Units);
                        Data_Item.Id        := Ada.Conversion.Unique_Id
                                                  (Remote_Compilation_Unit);
                        Db.List (Count)     := Data_Item;
                        Count               := Count + 1;

                        Ada.Next (Referenced_Units);
                    end loop;
                when others =>
                    null;
            end case;

            Ada.Next (Context_Clauses);
        end loop;

    end Initialize;

    procedure Mark_As_Used (Unique_Id     :        Long_Integer;
                            Db            : in out Database;
                            Use_Or_Rename :        Boolean) is
        No_Withs_Unused : Boolean := True;
    begin
        for I in 1 .. Db.Size loop
            if Db.List (I).Id = Unique_Id then
                if Use_Or_Rename then
                    Db.List (I).Used_By_Use_Or_Rename := True;
                else
                    Db.List (I).Used := True;
                end if;
            end if;
            No_Withs_Unused := No_Withs_Unused and Db.List (I).Used;
        end loop;
        if No_Withs_Unused then
            raise All_Used;
        end if;
    end Mark_As_Used;

    procedure Mark_As_Used (Id :        Ada_Program.Identifier_Reference;
                            Db : in out Database) is
        Id_Parent : Ada.Element := Ada.Parent (Id);

        Definition : Ada.Element := Ada.Definition (Id);

        Referenced_Comp_Unit : Ada.Element;

        Unique_Id : Long_Integer;
    begin
        if Ada_Program.Is_Nil (Definition) then
            null;
        else
            Referenced_Comp_Unit :=
               Compilation_Units.Parent_Compilation_Unit (Definition);

            Unique_Id := Ada.Conversion.Unique_Id (Referenced_Comp_Unit);

            case Ada.Kind (Id_Parent) is
                when Ada.A_Context_Clause =>
                    if Compilation_Units.Context_Clause_Kind (Id_Parent) =
                       Compilation_Units.A_Use_Clause then

                        Mark_As_Used (Unique_Id, Db, Use_Or_Rename => True);
                    end if;
                when Ada.A_Declaration =>
                    if Declarations.Is_Renaming_Declaration (Id_Parent) then

                        Mark_As_Used (Unique_Id, Db, Use_Or_Rename => True);
                    else
                        Mark_As_Used (Unique_Id, Db, Use_Or_Rename => False);
                    end if;
                when others =>
                    Mark_As_Used (Unique_Id, Db, Use_Or_Rename => False);
            end case;
        end if;
    end Mark_As_Used;

    function With_Id (Number : Positive; Db : Database)
                     return Ada_Program.Identifier_Reference is
    begin
        return Db.List (Number).With_Id;
    end With_Id;

    function Unit (Number : Positive; Db : Database)
                  return Ada_Program.Compilation_Unit is
    begin
        return Db.List (Number).Comp_Unit;
    end Unit;

    function Used (Number : Positive; Db : Database) return Boolean is
    begin
        return Db.List (Number).Used;
    end Used;

    function Used_By_Use_Or_Rename
                (Number : Positive; Db : Database) return Boolean is
    begin
        return Db.List (Number).Used_By_Use_Or_Rename;
    end Used_By_Use_Or_Rename;
end With_Accounting;

    nblk1=a
    nid=0
    hdr6=14
        [0x00] rec0=1b rec1=00 rec2=01 rec3=084
        [0x01] rec0=02 rec1=00 rec2=0a rec3=008
        [0x02] rec0=1d rec1=00 rec2=02 rec3=000
        [0x03] rec0=01 rec1=00 rec2=09 rec3=01a
        [0x04] rec0=13 rec1=00 rec2=03 rec3=038
        [0x05] rec0=01 rec1=00 rec2=08 rec3=03c
        [0x06] rec0=1e rec1=00 rec2=04 rec3=044
        [0x07] rec0=1b rec1=00 rec2=05 rec3=048
        [0x08] rec0=1e rec1=00 rec2=06 rec3=008
        [0x09] rec0=03 rec1=00 rec2=07 rec3=000
    tail 0x215004554815c66245cf2 0x42a00088462061e03