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

⟦7f8e6f8f8⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Analyze_Types, seg_0043fb

Derivation

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

with Type_Analysis;
with Ada_Traversal;
with Simple_Status;
with Errors;
with Common;
with Abstract_Document;
with Profile;
with Log;
with Declarations;
with Directory_Tools;
with Compilation_Units;
with Ada_Program;
with Lrm_Renames;
use Lrm_Renames;
with Directory_Renames;
use Directory_Renames;
procedure Analyze_Types (In_Units             : String  := "";
                         To_Preview_Object    : String  := "TYPE_INFO";
                         Include_Kind_Sort    : Boolean := True;
                         Include_Name_Sort    : Boolean := False;
                         Include_Scalar_Sort  : Boolean := False;
                         Include_Subtype_Sort : Boolean := False;
                         Include_Record_Sort  : Boolean := True;
                         Response             : String  := "<PROFILE>") is

    package Ad         renames Abstract_Document;
    package Ad_Specify renames Abstract_Document.Specify;

    Bad_Input_String : exception;

    Old_Profile : Profile.Response_Profile := Profile.Get;
    New_Profile : Profile.Response_Profile;

    Units_Iter : Object.Iterator := Naming.Resolution (In_Units);
    Obj        : Object.Handle;
    All_Decls  : Ada.Element_Iterator;

    Db : Type_Analysis.Db;

    Paragraph_Count : Positive        := 1;
    Document        : Abstract_Document.Handle;
    Current_Context : constant String := Naming.Default_Context;
    Object_Status   : Object.Error_Code;
    Status          : Errors.Condition;

    procedure Yield (Obj : Object.Handle) is
        Unit : Ada.Declaration;
    begin
        Unit := Compilation_Units.Unit_Declaration
                   (Ada.Conversion.To_Compilation_Unit (Obj));
        case Decls.Kind (Unit) is
            when Decls.A_Package_Declaration |
                 Decls.A_Generic_Package_Declaration =>

                All_Decls := Decls.Visible_Part_Declarations (Unit);

                while not Ada.Done (All_Decls) loop
                    case Decls.Kind (Ada.Value (All_Decls)) is
                        when Decls.A_Type_Declaration |
                             Decls.A_Task_Type_Declaration |
                             Decls.A_Subtype_Declaration =>

                            Type_Analysis.Add_Type_Decl
                               (Ada.Value (All_Decls), Db);

                        when others =>
                            null;
                    end case;

                    Ada.Next (All_Decls);
                end loop;

            when others =>
                null;
        end case;
    end Yield;

    procedure Traverse_All_Ada is new Ada_Traversal (Yield);
begin
    if Object.Is_Bad (Units_Iter) then
        raise Bad_Input_String;
    end if;

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

    Ad.Create (Document, To_Preview_Object, Status);

    Naming.Set_Default_Context (Current_Context, Object_Status);

    case Errors.Severity (Status) is
        when Simple_Status.Problem | Simple_Status.Fatal =>
            Log.Put_Line ("Problem creating object " & To_Preview_Object &
                          ".  " & Errors.Info (Status), Profile.Error_Msg);
            return; -- exit
        when others =>
            null;
    end case;

    Type_Analysis.Initialize (Db);

    Traverse_All_Ada (Units_Iter);

    Ad_Specify.Cover (Document, "TYPE INFORMATION");
    Ad_Specify.Cover_Item (Document, "");

    if Include_Kind_Sort then
        Ad_Specify.Paragraph (Document, Paragraph_Count,
                              "SORTED BY KIND OF TYPE");
        Paragraph_Count := Paragraph_Count + 1;
        Type_Analysis.Display (Db, Type_Analysis.Kind_Sort, Document);
    end if;

    if Include_Name_Sort then
        Ad_Specify.Paragraph (Document, Paragraph_Count,
                              "SORTED BY NAME OF TYPE");
        Paragraph_Count := Paragraph_Count + 1;
        Type_Analysis.Display (Db, Type_Analysis.Name_Sort, Document);
    end if;

    if Include_Scalar_Sort then
        Ad_Specify.Paragraph (Document, Paragraph_Count,
                              "SCALAR TYPES SORTED BY BOUNDS");
        Paragraph_Count := Paragraph_Count + 1;
        Type_Analysis.Display (Db, Type_Analysis.Scalar_Sort, Document);
    end if;

    if Include_Subtype_Sort then
        Ad_Specify.Paragraph (Document, Paragraph_Count,
                              "SUBTYPES SORTED BY NAME OF CONSTRAINED TYPE");
        Paragraph_Count := Paragraph_Count + 1;
        Type_Analysis.Display (Db, Type_Analysis.Subtype_Sort, Document);
    end if;

    if Include_Record_Sort then
        Ad_Specify.Paragraph
           (Document, Paragraph_Count,
            "RECORD TYPES SORTED to PRESERVE COMPONENT STRUCTURE");
        Paragraph_Count := Paragraph_Count + 1;
        Type_Analysis.Display (Db, Type_Analysis.Record_Sort, Document);
    end if;

    Ad.Close (Document);
    Common.Definition (To_Preview_Object);

    Profile.Set (Old_Profile);  
exception
    when Bad_Input_String =>
        Ad.Close (Document);
        Profile.Set (Old_Profile);
end Analyze_Types;

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=1e rec1=00 rec2=01 rec3=016
        [0x01] rec0=00 rec1=00 rec2=08 rec3=010
        [0x02] rec0=1c rec1=00 rec2=02 rec3=036
        [0x03] rec0=01 rec1=00 rec2=07 rec3=00c
        [0x04] rec0=1f rec1=00 rec2=03 rec3=080
        [0x05] rec0=1c rec1=00 rec2=04 rec3=054
        [0x06] rec0=17 rec1=00 rec2=05 rec3=090
        [0x07] rec0=0c rec1=00 rec2=06 rec3=001
    tail 0x2150032b0815c636ea94f 0x42a00088462061e03