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

⟦c3bd51ad0⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Hyper_Table, seg_004421

Derivation

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

with Io;
with Profile;
with Log;
with Errors;
with Debug_Tools;
with Ada_Traversal;
with Directory_Tools;
with Ada_Program;
with Table_Formatter;
with Simple_Status;
with Lrm_Renames;
use Lrm_Renames;
with Directory_Renames;
use Directory_Renames;
package body Hyper_Table is

    function Nil_Element_List return Ada_Program.Element_List is
    begin
        return Ada_Program.Nil_List;
    end Nil_Element_List;

    procedure Add_Hyper_Table (Units : in out Directory_Tools.Object.Iterator;
                               To_Document : in out Abstract_Document.Handle;
                               Response : String := "<PROFILE>") is
        Old_Profile : Profile.Response_Profile := Profile.Get;
        New_Profile : Profile.Response_Profile;

        Rows : array (Columns) of Integer;

        package Table is new Table_Formatter (Rows'Length);

        Fields : Table.Field_List (1 .. Columns'Pos (Columns'Last) + 1);

        Bool : Boolean := True;

        procedure Add_One_Row (Program_Element : Ada.Element) is
            Linkage_Element  : Ada.Element;
            Linkage_Elements : Ada.Element_List;
        begin
            for C in Columns loop

                Linkage (For_Column   => C,
                         For_Element  => Program_Element,
                         Linkage      => Linkage_Element,
                         Linkage_List => Linkage_Elements);

                Table.Item (Image (C, Program_Element),
                            Linkage      => Linkage_Element,
                            Linkage_List => Linkage_Elements,
                            Explanation  => Explanation (C, Program_Element));
            end loop;
        end Add_One_Row;

        procedure Pre_Op (Program_Element :        Ada.Element;
                          State           : in out Boolean;
                          Control         : in out Ada.Traversal_Control) is
        begin
           if Include_Element (Program_Element) then
                Add_One_Row (Program_Element);
            end if;
            Control := Ada.Continue;
        exception
            when others =>
                Log.Put_Line ("UNEXPECTED ERROR, EXCEPTION:" &
                              Debug_Tools.Get_Exception_Name,
                              Profile.Error_Msg);
                Log.Put_Line ("DIAGNOSIS: " & Ada.Diagnosis, Profile.Error_Msg);
                Log.Put_Line ("UNIT: " & Ada.Conversion.Get_Name
                                            (Comp_Units.Parent_Compilation_Unit
                                                (Program_Element)),
                              Profile.Error_Msg);
                Log.Put_Line ("On line: " &
                              Natural'Image (Ada.Line_Number (Program_Element)),
                              Profile.Error_Msg);

                Control := Ada.Continue;
        end Pre_Op;

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

        procedure Lrm_Traverse is new Ada.Depth_First_Traversal
                                         (Boolean, Pre_Op, Post_Op);

        procedure Include_Additional_Units
                     (List_Of_Elements : Ada.Element_List) is
            Elements : Ada.Element_List;
        begin
            -- create a local copy so the parameter does not have to be 'in out'
            Ada.Copy (List_Of_Elements, Elements);
            while not Ada.Done (Elements) loop
                Add_One_Row (Ada.Value (Elements));
                Ada.Next (Elements);
            end loop;
        end Include_Additional_Units;

        procedure Traverse (Unit : Object.Handle) is
        begin
            Lrm_Traverse (Ada.Conversion.To_Compilation_Unit (Unit),
                          Bool, False);
        end Traverse;

        procedure Traverse_All_Ada is new Ada_Traversal (Traverse);

    begin
        New_Profile := Profile.Value (Response);
        Profile.Set (New_Profile);

        for C in Columns loop
            Fields (Columns'Pos (C) + 1) := Columns'Pos (C) + 1;
            Table.Header (Columns'Image (C),
                          Is_Integer => Is_Integer_Valued (C));
        end loop;

        Io.Echo ("Traversing units...");
        Traverse_All_Ada (Units);

        Include_Additional_Units (Additional_Included_Elements);

        Io.Echo_Line ("Building abstract_document...");
        Table.Sort (Fields);
        Table.Display (To_Document, Table_Title);

        Profile.Set (Old_Profile);

    end Add_Hyper_Table;

end Hyper_Table;

    nblk1=6
    nid=0
    hdr6=c
        [0x00] rec0=23 rec1=00 rec2=01 rec3=020
        [0x01] rec0=18 rec1=00 rec2=02 rec3=006
        [0x02] rec0=00 rec1=00 rec2=06 rec3=002
        [0x03] rec0=15 rec1=00 rec2=03 rec3=026
        [0x04] rec0=18 rec1=00 rec2=04 rec3=02a
        [0x05] rec0=1e rec1=00 rec2=05 rec3=000
    tail 0x217001700815c63cf91ba 0x42a00088462061e03