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

⟦d31ca8c96⟧ Ada Source

    Length: 23552 (0x5c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Struct_Component, seg_049323

Derivation

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

E3 Source Code



with String_Utilities, Objets, Monde, Pnjs, Pieces, Lex;
package body Struct_Component is

    function Create return Attribut is
        Tmp_Att : Attribut;
    begin
        Bounded_String.Free (Tmp_Att.Name);
        Tmp_Att.Data := new Data_Box (Undef);
        return Tmp_Att;
    end Create;

    function Create return Structure is
        Tmp_Struct : Structure;
    begin
        Bounded_String.Free (Tmp_Struct.Name);
        Tmp_Struct.Attribut := Liste_Attribut.Create;
        return Tmp_Struct;
    end Create;

    procedure Is_Inside (Name : in String;
                         In_The_List : in Liste_Attribut.List;
                         Iterator : in out Liste_Attribut.Listiter;
                         Ok : in out Boolean) is
        Not_Found : Boolean := True;
        V : Attribut;
    begin
        Iterator := Liste_Attribut.Makelistiter (In_The_List);
        while (Liste_Attribut.More (Iterator) and Not_Found) loop
            V := Liste_Attribut.Cellvalue (Iterator);
            if Bounded_String.Image (V.Name) = Name then
                Not_Found := False;
            else
                Liste_Attribut.Forward (Iterator);
            end if;
        end loop;
        Ok := not (Not_Found);
    end Is_Inside;

    procedure Is_Inside (Name : in String;
                         In_The_List : in Liste_Structure.List;
                         Iterator : in out Liste_Structure.Listiter;
                         Ok : in out Boolean) is  
        Not_Found : Boolean := True;
        V : Structure;
    begin
        Iterator := Liste_Structure.Makelistiter (In_The_List);
        while (Liste_Structure.More (Iterator) and Not_Found) loop
            V := Liste_Structure.Cellvalue (Iterator);
            if Bounded_String.Image (V.Name) = Name then
                Not_Found := False;  
            else
                Liste_Structure.Forward (Iterator);
            end if;
        end loop;
        Ok := not (Not_Found);
    end Is_Inside;

    procedure Is_Inside_All (Name : in String;
                             Iterator : in out Liste_Structure.Listiter;
                             Found : in out Boolean) is
    begin
        Found := False;
        Is_Inside (String_Utilities.Upper_Case (Name),
                   Pieces.Liste, Iterator, Found);
        if not Found then
            Is_Inside (String_Utilities.Upper_Case (Name),
                       Pnjs.Liste, Iterator, Found);
            if not Found then
                Is_Inside (String_Utilities.Upper_Case (Name),
                           Objets.Liste, Iterator, Found);
                if not Found then
                    Is_Inside (String_Utilities.Upper_Case (Name),
                               Monde.Liste_Lien, Iterator, Found);
                end if;
            end if;
        end if;
    end Is_Inside_All;

    procedure Image (Of_A_Structure_List : in Liste_Structure.List) is  
        Iterator : Liste_Structure.Listiter;  
        Struct : Structure;
    begin  
        Iterator := Liste_Structure.Makelistiter (Of_A_Structure_List);
        while Liste_Structure.More (Iterator) loop
            Liste_Structure.Next (Iterator, Struct);

            Text_Io.Put_Line ("------------------------------------");
            Text_Io.Put (" Nom : ");
            Text_Io.Put_Line (Bounded_String.Image (Struct.Name));  
            Text_Io.Put_Line ("------------------------------------");  
            Image (Struct.Attribut);
        end loop;
    end Image;

    procedure Image (Of_An_Attribut_List : in Liste_Attribut.List) is  
        Iterator : Liste_Attribut.Listiter;  
        Att : Attribut;
    begin  
        Iterator := Liste_Attribut.Makelistiter (Of_An_Attribut_List);
        while Liste_Attribut.More (Iterator) loop
            Liste_Attribut.Next (Iterator, Att);
            Text_Io.Put (" Nom : ");  
            Text_Io.Put_Line (Bounded_String.Image (Att.Name));  
            Text_Io.Put_Line (" Donnee : ");
            Image (Att.Data.all);
            Text_Io.Put_Line ("- - - - - - - - - - - - - - - - - -");
        end loop;
    end Image;

    function Permute (List : in Liste_Structure.List)
                     return Liste_Structure.List is
        Tmp_List : Liste_Structure.List;
        Iterator : Liste_Structure.Listiter;
        Struct : Structure;
    begin
        Iterator := Liste_Structure.Makelistiter (List);
        while (Liste_Structure.More (Iterator)) loop
            Liste_Structure.Next (Iterator, Struct);
            Liste_Structure.Attach (Struct, Tmp_List);
        end loop;
        -- Liste_Structure.Destroy (List);
        return Tmp_List;
    end Permute;

    function Permute (List : in Liste_Attribut.List)
                     return Liste_Attribut.List is
        Tmp_List : Liste_Attribut.List;
        Iterator : Liste_Attribut.Listiter;
        Att : Attribut;
    begin
        Iterator := Liste_Attribut.Makelistiter (List);
        while (Liste_Attribut.More (Iterator)) loop
            Liste_Attribut.Next (Iterator, Att);
            Liste_Attribut.Attach (Att, Tmp_List);
        end loop;
        -- Liste_Attribut.Destroy (List);
        return Tmp_List;
    end Permute;

    procedure Image (L : in Enum_List) is
        Tmp_String : I_String;
        Iterator : String_Table.Int_List.Listiter;
    begin
        if not String_Table.Int_List.Isempty (L) then
            Iterator := String_Table.Int_List.Makelistiter (L);
            while String_Table.Int_List.More (Iterator) loop
                String_Table.Int_List.Next (Iterator, Tmp_String);
                Text_Io.Put (Bounded_String.Image (Tmp_String));
                Text_Io.Put (" ");
            end loop;
            Text_Io.New_Line;
        else
            Text_Io.Put_Line ("Liste Vide");
        end if;
    end Image;

    function Get_Value (Iter : in Liste_Attribut.Listiter)
                       return String_Table.I_String is
        Att : Attribut;
        Tmp_String : String_Table.I_String;
    begin  
        Bounded_String.Copy (Tmp_String, "ERROR");
        Att := Liste_Attribut.Cellvalue (Iter);
        case Att.Data.Box_Type is
            when Chaine =>
                return Att.Data.The_String;
            when Enum =>
                return Att.Data.Current_Enum;
            when Struct =>
                return Liste_Structure.Cellvalue (Att.Data.The_Structure).Name;
            when others =>
                return Tmp_String;
        end case;
    end Get_Value;

    function Get_Value (Iter : in Liste_Attribut.Listiter) return Natural is
        Att : Attribut;
    begin  
        Att := Liste_Attribut.Cellvalue (Iter);
        if Att.Data.Box_Type = Number then
            return Att.Data.The_Number;
        end if;
    end Get_Value;

    function Get_Value (Iter : in Liste_Attribut.Listiter)
                       return Liste_Structure.Listiter is
        Att : Attribut;
    begin
        Att := Liste_Attribut.Cellvalue (Iter);
        if Att.Data.Box_Type = Struct then
            return Att.Data.The_Structure;
        end if;
    end Get_Value;

    function Get_Value (Iter : in Liste_Attribut.Listiter) return Boolean is
        Att : Attribut;
    begin  
        Att := Liste_Attribut.Cellvalue (Iter);
        if Att.Data.Box_Type = Bool then
            return Att.Data.The_Boolean;
        end if;
    end Get_Value;

    function Get_Value (Iter : in Liste_Structure.Listiter)
                       return Liste_Attribut.List is
        Struc : Structure;
    begin  
        Struc := Liste_Structure.Cellvalue (Iter);
        return Struc.Attribut;
    end Get_Value;

    function Get_Name (Iter : in Liste_Structure.Listiter)
                      return String_Table.I_String is
        Struc : Structure;
    begin  
        Struc := Liste_Structure.Cellvalue (Iter);
        return Struc.Name;
    end Get_Name;

    function Get_Name (Iter : in Liste_Attribut.Listiter)                     return String_Table.I_String is
        Att : Attribut;
    begin  
        Att := Liste_Attribut.Cellvalue (Iter);
        return Att.Name;
    end Get_Name;

    procedure Set_Value (Att : in out Attribut; Str : String_Table.I_String) is
    begin
        if Att.Data.Box_Type = Chaine then
            Copy (Att.Data, Set_String (Att.Data.Name, Str));
        end if;
        if Att.Data.Box_Type = Enum then
            --Image (Att.Data.List_Of_Enum);
            Copy (Att.Data, Set_Enum
                               (Att.Data.Name, Str, Att.Data.List_Of_Enum));
        end if;
    end Set_Value;

    procedure Set_Value (Att : in out Attribut; Nbr : Natural) is
    begin
        if Att.Data.Box_Type = Number then
            Copy (Att.Data, Set_Number (Att.Data.Name, Nbr));
        end if;
    end Set_Value;

    procedure Set_Value (Att : in out Attribut;
                         Itr : Liste_Structure.Listiter) is
    begin
        if Att.Data.Box_Type = Struct then
            Copy (Att.Data, Set_Structure (Att.Data.Name, Itr, Objets.Liste));
        end if;
    end Set_Value;

    procedure Set_Value (Att : in out Attribut; Abool : Boolean) is
    begin
        if Att.Data.Box_Type = Bool then
            Copy (Att.Data, Set_Boolean (Att.Data.Name, Abool));
        end if;
    end Set_Value;

    function Set_String (Name : in String; Value : in String) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Chaine);
    begin
        Bounded_String.Copy (Tmp_Box.Name, String_Utilities.Upper_Case (Name));
        Bounded_String.Copy (Tmp_Box.The_String, Value);  
        return Tmp_Box;
    end Set_String;

    function Set_String
                (Name : in I_String; Value : in String) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Chaine);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
        Bounded_String.Copy (Tmp_Box.The_String, Value);
        return Tmp_Box;
    end Set_String;

    function Set_String
                (Name : in I_String; Value : in I_String) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Chaine);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
        Bounded_String.Copy (Tmp_Box.The_String, Value);
        return Tmp_Box;
    end Set_String;

    function Set_Number (Name : in String; Value : in String) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Number);
    begin
        Bounded_String.Copy (Tmp_Box.Name, String_Utilities.Upper_Case (Name));
        Tmp_Box.The_Number := Natural'Value (Value);
        return Tmp_Box;
    end Set_Number;

    function Set_Number
                (Name : in I_String; Value : in String) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Number);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
        Tmp_Box.The_Number := Natural'Value (Value);
        return Tmp_Box;
    end Set_Number;

    function Set_Number
                (Name : in I_String; Value : in Natural) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Number);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
        Tmp_Box.The_Number := Value;
        return Tmp_Box;
    end Set_Number;

    function Set_Structure (Name : in String;
                            Value : in Liste_Structure.Listiter;
                            With_List : Liste_Structure.List) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Struct);
    begin
        Bounded_String.Copy (Tmp_Box.Name, String_Utilities.Upper_Case (Name));
        -- Text_Io.Put_Line (Bounded_String.Image
        --                     (Liste_Structure.Cellvalue (Value).Name));
        -- Tmp_Box.The_Structure := Liste_Structure.Makelistiter (With_List);
        Tmp_Box.The_Structure := Value;
        Tmp_Box.From_List := With_List;
        return Tmp_Box;
    end Set_Structure;

    function Set_Structure (Name : in I_String;
                            Value : in Liste_Structure.Listiter;
                            With_List : Liste_Structure.List) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Struct);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
--        Text_Io.Put_Line (Bounded_String.Image
--                             (Liste_Structure.Cellvalue (Value).Name));
--        Tmp_Box.The_Structure := Liste_Structure.Makelistiter (With_List);
        Tmp_Box.The_Structure := Value;
        Tmp_Box.From_List := With_List;
        return Tmp_Box;
    end Set_Structure;

    function Set_Enum (Name : in String;
                       Value : in String;
                       List_Enum : in Enum_List) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Enum);
    begin
        Bounded_String.Copy (Tmp_Box.Name, String_Utilities.Upper_Case (Name));
        Bounded_String.Copy (Tmp_Box.Current_Enum,
                             String_Utilities.Upper_Case (Value));
        Tmp_Box.List_Of_Enum := List_Enum;
        return Tmp_Box;
    end Set_Enum;

    function Set_Enum (Name : in I_String;
                       Value : in String;
                       List_Enum : in Enum_List) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Enum);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
        Bounded_String.Copy (Tmp_Box.Current_Enum,
                             String_Utilities.Upper_Case (Value));
        Tmp_Box.List_Of_Enum := List_Enum;
        return Tmp_Box;
    end Set_Enum;

    function Set_Enum (Name : in I_String;
                       Value : in I_String;
                       List_Enum : in Enum_List) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Enum);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
        Bounded_String.Copy (Tmp_Box.Current_Enum,
                             String_Utilities.Upper_Case
                                (Bounded_String.Image (Value)));
        Tmp_Box.List_Of_Enum := List_Enum;
        return Tmp_Box;
    end Set_Enum;

    function Set_Boolean
                (Name : in String; Value : in Boolean) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Bool);
    begin
        Bounded_String.Copy (Tmp_Box.Name, String_Utilities.Upper_Case (Name));
        Tmp_Box.The_Boolean := Value;
        return Tmp_Box;
    end Set_Boolean;

    function Set_Boolean
                (Name : in I_String; Value : in Boolean) return Data_Box is
        Tmp_Box : Data_Box (Box_Type => Bool);
    begin
        Bounded_String.Copy (Tmp_Box.Name, Name);
        Tmp_Box.The_Boolean := Value;
        return Tmp_Box;
    end Set_Boolean;

    procedure Image (A_Box : in Data_Box) is
    begin
        Text_Io.Put ("  Nom : ");
        Text_Io.Put_Line (Bounded_String.Image (A_Box.Name));
        Text_Io.Put_Line ("  Type : " & Kind_Of_Box'Image (A_Box.Box_Type));
        Text_Io.Put ("  Val : ");
        case A_Box.Box_Type is
            when Undef =>
                Text_Io.Put_Line ("/");
            when Chaine =>
                Text_Io.Put_Line (Bounded_String.Image (A_Box.The_String));
            when Number =>
                Text_Io.Put_Line (Natural'Image (A_Box.The_Number));
            when Struct =>
                Text_Io.Put_Line (Bounded_String.Image
                                     (Liste_Structure.Cellvalue
                                         (A_Box.The_Structure).Name));
            when Enum =>
                Text_Io.Put_Line (Bounded_String.Image (A_Box.Current_Enum));
                Text_Io.Put ("   Parmis : ");
                Image (A_Box.List_Of_Enum);
            when Bool =>
                Text_Io.Put_Line (Boolean'Image (A_Box.The_Boolean));
        end case;
    end Image;

    procedure Copy (Dest_Box : in out Data_Box; Source_Box : in Data_Box) is
    begin
        case Source_Box.Box_Type is  
            when Undef =>
                null;
            when Chaine =>
                Dest_Box := Set_String (Source_Box.Name, Source_Box.The_String);
            when Number =>
                Dest_Box := Set_Number (Source_Box.Name, Source_Box.The_Number);
            when Struct =>
                Dest_Box := Set_Structure
                               (Source_Box.Name, Source_Box.The_Structure,
                                Source_Box.From_List);
            when Enum =>
                Dest_Box := Set_Enum (Source_Box.Name, Source_Box.Current_Enum,
                                      Source_Box.List_Of_Enum);
            when Bool =>
                Dest_Box := Set_Boolean (Source_Box.Name,
                                         Source_Box.The_Boolean);
        end case;
    end Copy;

    procedure Copy (Dest_Box : in out Box_Ptr; Source_Box : in Data_Box) is
        Tmp_Box : Data_Box (Undef);
    begin
        case Source_Box.Box_Type is
            when Undef =>
                Dest_Box := null;
            when Chaine =>
                Dest_Box := new Data_Box (Chaine);
                Dest_Box.all := Set_String
                                   (Source_Box.Name, Source_Box.The_String);
            when Number =>
                Dest_Box := new Data_Box (Number);
                Dest_Box.all := Set_Number
                                   (Source_Box.Name, Source_Box.The_Number);
            when Struct =>
                Dest_Box := new Data_Box (Struct);
                Dest_Box.all := Set_Structure
                                   (Source_Box.Name, Source_Box.The_Structure,
                                    Source_Box.From_List);
            when Enum =>  
                Dest_Box := new Data_Box (Enum);
                Dest_Box.all := Set_Enum
                                   (Source_Box.Name, Source_Box.Current_Enum,
                                    Source_Box.List_Of_Enum);
            when Bool =>  
                Dest_Box := new Data_Box (Bool);
                Dest_Box.all := Set_Boolean
                                   (Source_Box.Name, Source_Box.The_Boolean);
        end case;
    end Copy;

end Struct_Component;

E3 Meta Data

    nblk1=16
    nid=0
    hdr6=2c
        [0x00] rec0=1e rec1=00 rec2=01 rec3=016
        [0x01] rec0=19 rec1=00 rec2=11 rec3=00e
        [0x02] rec0=19 rec1=00 rec2=05 rec3=05e
        [0x03] rec0=17 rec1=00 rec2=09 rec3=048
        [0x04] rec0=1a rec1=00 rec2=10 rec3=022
        [0x05] rec0=1a rec1=00 rec2=13 rec3=006
        [0x06] rec0=1c rec1=00 rec2=14 rec3=018
        [0x07] rec0=08 rec1=00 rec2=12 rec3=010
        [0x08] rec0=1f rec1=00 rec2=15 rec3=002
        [0x09] rec0=16 rec1=00 rec2=0a rec3=048
        [0x0a] rec0=1c rec1=00 rec2=0e rec3=06e
        [0x0b] rec0=03 rec1=00 rec2=0f rec3=002
        [0x0c] rec0=1a rec1=00 rec2=07 rec3=034
        [0x0d] rec0=17 rec1=00 rec2=06 rec3=032
        [0x0e] rec0=18 rec1=00 rec2=02 rec3=036
        [0x0f] rec0=18 rec1=00 rec2=0d rec3=048
        [0x10] rec0=1c rec1=00 rec2=16 rec3=02a
        [0x11] rec0=02 rec1=00 rec2=08 rec3=04e
        [0x12] rec0=16 rec1=00 rec2=0b rec3=084
        [0x13] rec0=17 rec1=00 rec2=0c rec3=02c
        [0x14] rec0=15 rec1=00 rec2=03 rec3=09a
        [0x15] rec0=0a rec1=00 rec2=04 rec3=000
    tail 0x2174d9f90865b74db3a58 0x42a00088462060003