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

⟦e25faeec8⟧ Ada Source

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

Derivation

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

with Text_Io, Bounded_String, Lists;

package body Fields is
    use Fields_List;


    function Create_Field (N : String; T : String) return Field is
        A : Field;
    begin
        Bounded_String.Free (A.Field_Name);
        Bounded_String.Copy (A.Field_Name, N);
        Bounded_String.Free (A.Field_Type);
        Bounded_String.Copy (A.Field_Type, T);
        return A;
    end Create_Field;


    function Isequal (X, Y : in Field) return Boolean is
    begin
        declare
            use Bounded_String;
        begin
            if Image (X.Field_Name) = Image (Y.Field_Name) then
                return True;
            else
                return False;
            end if;
        end;
    end Isequal;


    procedure Dispose_Field (The_Field : in out Field) is
    begin
        Bounded_String.Free (The_Field.Field_Name);
        Bounded_String.Free (The_Field.Field_Type);
    end Dispose_Field;

    procedure Destroy_Object is new Destroydeep (Dispose => Dispose_Field);

    function Copy_Field (The_Field : Field) return Field is
    begin
        return Create_Field (Bounded_String.Image (The_Field.Field_Name),
                             Bounded_String.Image (The_Field.Field_Type));
    end Copy_Field;
    function Copy_Object is new Copydeep (Copy => Copy_Field);

--Creation
    procedure Create (D : in out Object) is
    begin
        D.Node := Create;
    end Create;

--Access
    function Has_Field (D : in Object; Name : in String) return Boolean is
    begin
        if not Isempty (D.Node) then
            return Isinlist (D.Node, Create_Field (Name, Name));
        else
            return False;
        end if;
    end Has_Field;

    function Get_Field_Type_By_Name (D : Object; Name : String) return String is

        Index : Field_Index;
        Info : Field;
        Search : Field;
        Found : Boolean := False;
    begin
        if not Isempty (D.Node) then
            Search := Create_Field (Name, Name);
            Index.Node := Makelistiter (D.Node);
            while (More (Index.Node) and not Found) loop
                Next (Index.Node, Info);
                if Isequal (Info, Search) then
                    Found := True;
                    return (Bounded_String.Image (Info.Field_Type));
                end if;
            end loop;
        else
            raise Error_Field_Empty;
        end if;
    end Get_Field_Type_By_Name;

    procedure Dump_Fields (D : in Object) is
        Index : Field_Index;
        Info : Field;
    begin
        if not Isempty (D.Node) then
            declare
                use Bounded_String;
            begin
                Index.Node := Makelistiter (D.Node);
                while (More (Index.Node)) loop
                    Next (Index.Node, Info);
                    Text_Io.Put_Line ("Nom: " & Image (Info.Field_Name) &
                                      "  Type: " & Image (Info.Field_Type));
                end loop;
            end;
        else
            raise Error_Field_Empty;
        end if;
    end Dump_Fields;


    procedure Dump_Number_Of_Field (D : in Object) is
    begin
        Text_Io.Put_Line ("Number of field : " &
                          Integer'Image (Fields_List.Length (D.Node)));
    end Dump_Number_Of_Field;

    procedure Surface_Copy (To_Fields : in out Object; The_Fields : Object) is
    begin
        To_Fields.Node := The_Fields.Node;
    end Surface_Copy;

    procedure Deep_Copy (To_Fields : in out Object; The_Fields : Object) is
    begin
        To_Fields.Node := Copy_Object (The_Fields.Node);
    end Deep_Copy;


--    function Object_Image (D : in Object) return String;

--Modification
    procedure Store_Field (D : in out Object; Aname : String; Atype : String) is
    begin
        if not Isempty (D.Node) then
            Attach (D.Node, Create_Field (Aname, Atype));
        else
            Attach (Create_Field (Aname, Atype), D.Node);
        end if;
    end Store_Field;

--Liberation
    procedure Dispose_Object (D : in out Object) is
    begin
        if not Isempty (D.Node) then
            Destroy_Object (D.Node);
        end if;
    end Dispose_Object;

--Iteration
    procedure Open_Field_Indexation (D : Object; I : in out Field_Index) is
    begin
        I.Node := Makelistiter (D.Node);
    end Open_Field_Indexation;

    procedure Next_Field_Index (I : in out Field_Index) is
        Info : Field;
    begin
        Next (I.Node, Info);
    end Next_Field_Index;

    function Get_Indexed_Field_Name (I : Field_Index) return String is
        Info : Field;
    begin
        Info := Cellvalue (I.Node);
        return Bounded_String.Image (Info.Field_Name);
    end Get_Indexed_Field_Name;

    function Get_Indexed_Field_Type (I : Field_Index) return String is
        Info : Field;
    begin
        Info := Cellvalue (I.Node);
        return Bounded_String.Image (Info.Field_Type);
    end Get_Indexed_Field_Type;

    function No_More_Fields (I : Field_Index) return Boolean is
    begin
        return not More (I.Node);
    end No_More_Fields;

end Fields;

    nblk1=6
    nid=0
    hdr6=c
        [0x00] rec0=27 rec1=00 rec2=01 rec3=026
        [0x01] rec0=20 rec1=00 rec2=02 rec3=018
        [0x02] rec0=1b rec1=00 rec2=03 rec3=014
        [0x03] rec0=20 rec1=00 rec2=04 rec3=020
        [0x04] rec0=21 rec1=00 rec2=05 rec3=082
        [0x05] rec0=0d rec1=00 rec2=06 rec3=001
    tail 0x2174d6936865b465894d4 0x42a00088462060003