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

⟦4e5ae6df4⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Display_Lib, seg_004517

Derivation

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

with Log;
with Common;
with Errors;
with Profile;  
with Directory;
with Simple_Status;  
with Bounded_String;
with Table_Formatter;
with Directory_Tools;
with String_Utilities;
with Directory_Renames;
use Directory_Renames;
with Abstract_Document;
with String_Map_Generic;
with Create_Null_Document;
with Sequential_Reference;
procedure Display_Lib (Root              : String  := "<cursor>";
                       To_Preview_Object : String  := "Library_Info";
                       Include_Units     : Boolean := True;
                       Include_Views     : Boolean := True;
                       Showing_Class     : Boolean := True;
                       Showing_State     : Boolean := False;
                       Showing_Sizes     : Boolean := False;
                       Showing_Locks     : Boolean := False;
                       Showing_Acls      : Boolean := False) is

    Root_Obj  : Object.Handle := Naming.Resolution (Root);
    Documnt  : Abstract_Document.Handle;
    Condition : Errors.Condition;

    -- subtype Acl_String is Bounded_String.Variable_String (256);
    --
    -- function Hash (Acl : Acl_String) return Integer;
    --
    -- package Acl_Reference is new Sequential_Reference
    --                                 (Acl_String, Hash, Bounded_String.Image);

    package Acl_Reference is new String_Map_Generic (1000, Natural);

    Acl_List : Acl_Reference.Map;

    Next_Acl_Index : Natural := 1;

    package Su renames String_Utilities;

    type Column_Flags is array (1 .. 5) of Boolean;

    -- function Hash (Acl : Acl_String) return Integer is
    -- begin
    --     return String_Utilities.Hash_String (Bounded_String.Image (Acl));
    -- end Hash;
    --

    function Get_Acl_Index (Acl : String) return Natural is
    begin
        declare
        begin
            Acl_Reference.Define (Acl_List, Acl, Next_Acl_Index, True);
            Next_Acl_Index := Nxt_Acl_Index + 1;
        exception
            when Acl_Reference.Multiply_Defined =>
                null;
        end;  
        return Acl_Reference.Eval (Acl_List, Acl);
    end Get_Acl_Index;

    function Count_Table_Columns (Flags : Column_Flags) return Positive is
        Count : Positive := 1;
    begin
        for I in Flags'Range loop
            if Flags (I) then
                Count := Count + 1;
            end if;
        end loop;
        return Count;
    end Count_Table_Columns;

    package Table is new Table_Formatter
                            (Count_Table_Columns
                                ((Showing_Class, Showing_State, Showing_Sizes,
                                  Showing_Locks, Showing_Acls)));

    function Class_Image (Of_Object : Object.Handle) return String is separate;

    procedure Display (Obj         : Object.Handle;
                       Indentation : String;
                       Document    : Abstract_Document.Handle) is separate;

    procedure Traverse (Obj         : Object.Handle;
                        Indentation : String;
                        Document    : Abstract_Document.Handle) is separate;
begin
    if Object.Is_Bad (Root_Obj) then
        Log.Put_Line ("Problem accessing root object: " &
                      Root & Object.Message (Root_Obj), Profile.Error_Msg);
    else
        Table.Header ("Object Simple Name");
        if Showing_Class then
            Table.Header ("Class(Subclass)");
        end if;  
        if Showing_State then
            Table.Header (S => "State", Format => Table.Centered);
        end if;
        if Showing_Sizes then
            Table.Header (S => "Size", Format => Table.Right);
        end if;  
        if Showing_Locks then
            Table.Header ("Locks");
        end if;  
        if Showing_Acls then
            Table.Header ("ACL's");
            Acl_Reference.Initialize (Acl_List);
        end if;

        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 =>

                Traverse (Root_Obj, "", Document);

                Table.Display (Document, Su.Capitalize
                                            (Naming.Full_Name (Root_Obj)));
                Abstract_Document.Close (Document);

                Common.Definition (To_Preview_Object);
        end case;
    end if;
end Display_Lib;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=1d rec1=00 rec2=01 rec3=012
        [0x01] rec0=00 rec1=00 rec2=07 rec3=002
        [0x02] rec0=1f rec1=00 rec2=02 rec3=03e
        [0x03] rec0=00 rec1=00 rec2=06 rec3=002
        [0x04] rec0=1c rec1=00 rec2=03 rec3=054
        [0x05] rec0=1a rec1=00 rec2=04 rec3=00e
        [0x06] rec0=17 rec1=00 rec2=05 rec3=000
    tail 0x215003a50815c649bbf62 0x42a00088462061e03