DataMuseum.dk

top - metrics - download

    Length: 5563 (0x15bb)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Element_Size;
with String_Utilities;
with Lines;  
with Names_And_Expressions;
with Ada_Program;
with Representation_Clauses;  
with Type_Information;
with Declarations;
package body Representation_Elements is
    package Ap   renames Ada_Program;
    package Reps renames Representation_Clauses;
    package Ne   renames Names_And_Expressions;
    package Ti   renames Type_Information;  
    package Su   renames String_Utilities;

    function Make (Record_Type : Record_Type_Definition)
                  return Record_Kind_List is
        L               : Rec_List.Queue;
        E               : Ap.Element;
        Components_Iter : Ada_Program.Element_Iterator :=
           Type_Information.Record_Components (Record_Type);
    begin
        while not Ap.Done (Components_Iter) loop
            declare
                Item : Record_Kind;
            begin
                E := Ap.Value (Components_Iter);
                Ubs.Copy (Item.Name, Su.Upper_Case (Declarations.Name (E)));
                Item.Size := Element_Size (Declarations.Object_Type (E));

                Rec_List.Add (Q => L, X => Item);
                Ap.Next (Components_Iter);
            end;
        end loop;  
        return Record_Kind_List (L);
    end Make;
    procedure Init (Iter : out Record_Kind_Iterator; L : Record_Kind_List) is
        I : Record_Kind_Iterator := new Rec_List.Iterator;
    begin
        Rec_List.Init (Iter => I.all, Q => Rec_List.Queue (L));
        Iter := I;
    end Init;

    procedure Next (Iter : in out Record_Kind_Iterator) is
    begin
        Rec_List.Next (Iter => Iter.all);
    end Next;

    function Value (Iter : Record_Kind_Iterator) return Record_Kind is
    begin
        return Rec_List.Value (Iter.all);
    end Value;

    function Done (Iter : Record_Kind_Iterator) return Boolean is
    begin
        return Rec_List.Done (Iter.all);
    end Done;

    function Name (E : Record_Kind) return String is
    begin
        return Ubs.Image (E.Name);
    end Name;

    function Size (E : Record_Kind) return Long_Natural is
    begin
        return E.Size;
    end Size;

    function Component_Image (E : Record_Kind) return String is
    begin
        return Ubs.Image (E.Image);
    end Component_Image;
    function Make (Rep_Element : Representation_Clause) return Data is

        E            : Ap.Element;
        Rep_Iter     : Ada_Program.Element_Iterator :=
           Reps.Clause_Components (Record_Clause => Rep_Element);
        Lower, Upper : Ti.Expression;
        Count        : Natural := 0;
        function Name_Only (Str : String) return String is
            -- need to do this due to a bug in Reps.Component_Name
            --
            Last : Natural := Su.Locate (' ', Str);
        begin
            if Last = 0 then
                return Str;
            else
                return Str (Str'First .. Last - 1);
            end if;
        end Name_Only;
    begin
        while not Ap.Done (Rep_Iter) loop
            Count := Count + 1;
            Ap.Next (Rep_Iter);
        end loop;  
        declare
            List : Data (1 .. Count);
        begin
            Rep_Iter := Reps.Clause_Components (Record_Clause => Rep_Element);

            for I in List'Range loop
                E := Ap.Value (Rep_Iter);
                if Reps.Valid_Component (Component_Clause => E) then
                    declare
                        Item : Record_Rep;
                    begin
                        Ubs.Copy (Item.Name,
                                  Name_Only (Su.Upper_Case
                                                ((Reps.Component_Name (E)))));
                        Item.Word_Pos := Ne.Static_Value
                                            (Reps.Component_Offset (E));
                        Ti.Bounds (Reps.Component_Range (E), Lower, Upper);
                        Item.Range_Start := Ne.Static_Value (Lower);
                        Item.Range_End := Ne.Static_Value (Upper);
                        Item.Size := Item.Range_End - Item.Range_Start + 1;
                        Ubs.Copy (Item.Image, Ada_Program.Image (E));
                        Item.Associated_Errors := Lines.Make;

                        Item.Index := I;
                        List (I)   := Item;
                    end;
                end if;
                Ap.Next (Rep_Iter);
            end loop;  
            return List;
        end;
    end Make;
    procedure Add_Error (E : in out Record_Rep; Error : String) is
    begin
        Lines.Add (Error, E.Associated_Errors);
    end Add_Error;
    function Name (E : Record_Rep) return String is
    begin
        return Ubs.Image (E.Name);
    end Name;

    function Size (E : Record_Rep) return Long_Natural is
    begin
        return E.Size;
    end Size;

    function Word_Position (E : Record_Rep) return Long_Natural is
    begin
        return E.Word_Pos;
    end Word_Position;

    function Start_Bit (E : Record_Rep) return Long_Natural is
    begin
        return E.Range_Start;
    end Start_Bit;

    function End_Bit (E : Record_Rep) return Long_Natural is
    begin
        return E.Range_End;
    end End_Bit;
    function Component_Image (E : Record_Rep) return String is
    begin
        return Ubs.Image (E.Image);
    end Component_Image;
    function Index (E : Record_Rep) return Positive is
    begin
        return E.Index;
    end Index;  
    function Errors (E : Record_Rep) return Lines.Lines_Type is
    begin
        return E.Associated_Errors;
    end Errors;
end Representation_Elements;