DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦c049453b7⟧ TextFile

    Length: 19449 (0x4bf9)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Binary_Tree;
with Bounded_String;
with Text_Io;
with String_Map_Generic;
with String_Utilities;
package body Symbol is


    ------------------ structure de donnees ----------------------------------
    --------------------------------------------------------------------------

    type Second_Level_Item is
        record
            The_Type : Symbol_Type := No_Type;
            The_Value : Natural := 0;
            Parameter_Number : Natural := 0;
        end record;

    package Second_Level_Map is new String_Map_Generic (17, Second_Level_Item);

    type First_Level_Item is

        record  
            The_Node : Binary_Tree.Node := null;
            The_Type : Symbol_Type := No_Type;
            The_Value : Natural := 0;
            The_Table : Second_Level_Map.Map := Second_Level_Map.Nil;
        end record;

    package First_Level_Map is new String_Map_Generic (127, First_Level_Item);




    ------------------ declaration des variables -----------------------------
    --------------------------------------------------------------------------


    The_Table : First_Level_Map.Map := First_Level_Map.Nil;
    Current_Second_Level_Map : Second_Level_Map.Map := Second_Level_Map.Nil;
    Current_First_Level_Item : First_Level_Item;
    Current_Second_Level_Item : Second_Level_Item;
    Current_Level : Natural := 1;
    Nb_Of_Tmp_Var : Integer := 0;
    Current_Actor_Id : Natural := 0;
    The_Parameter_Number : Natural := 1;



    ------------------ implementation des procedures -------------------------
    --------------------------------------------------------------------------

    procedure Initialize is
    begin
        First_Level_Map.Initialize (The_Table);
    end Initialize;


    function Tmp_Var_Name return String is
    begin
        Nb_Of_Tmp_Var := Nb_Of_Tmp_Var + 1;
        return ("_tmp" & String_Utilities.Number_To_String (Nb_Of_Tmp_Var));
    end Tmp_Var_Name;




    procedure Add_Material (Material_Name : String) is
    begin
        Current_Actor_Id := 0;
        Current_First_Level_Item.The_Type := Material;
        Current_First_Level_Item.The_Value := 0;
        Second_Level_Map.Initialize (Current_First_Level_Item.The_Table);
        Current_Second_Level_Map := Current_First_Level_Item.The_Table;

        First_Level_Map.Define (The_Table, Material_Name,
                                Current_First_Level_Item, True);
    exception
        when First_Level_Map.Multiply_Defined =>
            Text_Io.Put
               ("*** Erreur *** Il existe deja un type de materiel nomme ");
            Text_Io.Put (Material_Name);
            Text_Io.Put_Line (" ...");
    end Add_Material;





    procedure Add_Actor (Actor_Name : String; T : Symbol_Type) is
    begin
        Current_Second_Level_Item.The_Value := Current_Actor_Id;
        Current_Actor_Id := Current_Actor_Id + 1;
        Current_Second_Level_Item.The_Type := T;
        Second_Level_Map.Define (Current_Second_Level_Map, Actor_Name,
                                 Current_Second_Level_Item, True);
    exception
        when Second_Level_Map.Multiply_Defined =>
            Text_Io.Put ("*** Erreur *** Il existe deja un acteur nomme ");
            Text_Io.Put (Actor_Name);
            Text_Io.Put_Line (" ...");
    end Add_Actor;


    function Get_Actor_Value
                (Theatre_Name : String; Actor_Name : String) return Natural is
        The_First_Level_Item : First_Level_Item;
        The_Second_Level_Item : Second_Level_Item;
        Ok : Boolean := False;

    begin  
        First_Level_Map.Find (The_Table, Theatre_Name,
                              The_First_Level_Item, Ok);
        if Ok then
            Second_Level_Map.Find (The_First_Level_Item.The_Table,
                                   Actor_Name, The_Second_Level_Item, Ok);
            if Ok then
                return The_Second_Level_Item.The_Value;
            else
                Text_Io.Put_Line
                   ("*** Il n'y a pas un tel acteur pour cette station");
            end if;
        else
            Text_Io.Put_Line ("*** Il n'y a pas de station de ce nom");  
        end if;
        return 0;
    end Get_Actor_Value;


    function Get_Theatre_Adress (Theatre_Name : String) return Natural is
        The_First_Level_Item : First_Level_Item;
        Ok : Boolean := False;
    begin
        First_Level_Map.Find (The_Table, Theatre_Name,
                              The_First_Level_Item, Ok);
        if Ok then
            return The_First_Level_Item.The_Value;
        else
            Text_Io.Put_Line ("*** Erreur *** La station n'existe pas");
        end if;
    end Get_Theatre_Adress;


    procedure Add_Theatre
                 (Theatre_Name, Material_Name : String; Adress : Natural) is
        Ok : Boolean := False;
    begin
        First_Level_Map.Find (The_Table, Material_Name,
                              Current_First_Level_Item, Ok);
        if Ok then
            Current_First_Level_Item.The_Type := Theatre;
            Current_First_Level_Item.The_Value := Adress;
            First_Level_Map.Define (The_Table, Theatre_Name,
                                    Current_First_Level_Item, True);
        else
            Text_Io.Put ("*** Error *** Le type de materiel ");
            Text_Io.Put (Material_Name);
            Text_Io.Put_Line (" n'existe pas ...");
        end if;
    exception
        when First_Level_Map.Multiply_Defined =>
            Text_Io.Put ("*** Erreur *** Il y a deja un ");  
            Text_Io.Put (Theatre_Name);
            Text_Io.Put_Line (" ...");

    end Add_Theatre;


    procedure Add_Function (Function_Name : String) is
    begin
        Current_First_Level_Item.The_Type := Sub_Prog;
        Current_First_Level_Item.The_Value := 0;
        Second_Level_Map.Initialize (Current_First_Level_Item.The_Table);
        Current_Second_Level_Map := Current_First_Level_Item.The_Table;

        First_Level_Map.Define (The_Table, Function_Name,
                                Current_First_Level_Item, True);
    exception
        when First_Level_Map.Multiply_Defined =>
            Text_Io.Put ("*** Erreur *** Il y a deja une fonction ");
            Text_Io.Put (Function_Name);
            Text_Io.Put_Line (" ...");
    end Add_Function;


    procedure Set_Current_Level (To : Natural; Function_Name : String) is
        The_First_Level_Item : First_Level_Item;
        Success : Boolean := False;
    begin  
        The_Parameter_Number := 1;
        if To in 1 .. 2 then
            Current_Level := To;
            if Current_Level = 2 then
                First_Level_Map.Find (The_Table, Function_Name,
                                      The_First_Level_Item, Success);
                if Success then
                    Current_Second_Level_Map := The_First_Level_Item.The_Table;
                else
                    Text_Io.Put ("*** Error *** La fonction ");
                    Text_Io.Put (Function_Name);
                    Text_Io.Put_Line (" n'existe pas ...");
                end if;
            end if;  
        else
            Text_Io.Put_Line ("*** Error *** Niveau non autorise ...");
        end if;
    end Set_Current_Level;


    function Get_Current_Level return Natural is
    begin
        return Current_Level;
    end Get_Current_Level;


    procedure Add_Variable (Variable_Name : String;
                            The_Type : Symbol_Type := No_Type;
                            The_Value : Natural := 0) is
        The_First_Level_Item : First_Level_Item;
        The_Second_Level_Item : Second_Level_Item;
    begin
        if Current_Level = 1 then
            The_First_Level_Item.The_Type := The_Type;
            The_First_Level_Item.The_Value := The_Value;
            First_Level_Map.Define (The_Table, Variable_Name,
                                    The_First_Level_Item, True);
        else
            The_Second_Level_Item.The_Type := The_Type;
            The_Second_Level_Item.The_Value := The_Value;
            The_Second_Level_Item.Parameter_Number := The_Parameter_Number;
            Second_Level_Map.Define (Current_Second_Level_Map, Variable_Name,
                                     The_Second_Level_Item, True);
        end if;
    exception
        when First_Level_Map.Multiply_Defined |
             Second_Level_Map.Multiply_Defined =>
            Text_Io.Put ("*** Erreur *** Il existe deja une variable nommee ");
            Text_Io.Put (Variable_Name);
            Text_Io.Put_Line (" ...");
    end Add_Variable;


    procedure Add_Parameter (Variable_Name : String;
                             The_Type : Symbol_Type := No_Type;
                             The_Value : Natural := 0) is
    begin  
        Add_Variable (Variable_Name, The_Type, The_Value);
        The_Parameter_Number := The_Parameter_Number + 1;
    end Add_Parameter;


    procedure Get_Variable (Variable_Name : String;
                            The_Type : out Symbol_Type;
                            The_Value : out Natural;
                            Success : out Boolean) is
        The_First_Level_Item : First_Level_Item;
        The_Second_Level_Item : Second_Level_Item;
        Ok : Boolean := False;
        T : Symbol_Type;
        V : Natural;
    begin
        if Current_Level = 2 then
            Get_Variable_From_2 (Variable_Name, T, V, Ok);
            if not Ok then
                Get_Variable_From_1 (Variable_Name, T, V, Ok);
            end if;
        else
            Get_Variable_From_1 (Variable_Name, T, V, Ok);
        end if;
        The_Type := T;
        The_Value := V;
        Success := Ok;
    end Get_Variable;



    procedure Get_Variable_From_1 (Variable_Name : String;
                                   The_Type : out Symbol_Type;
                                   The_Value : out Natural;
                                   Success : out Boolean) is
        The_First_Level_Item : First_Level_Item;
        Ok : Boolean := False;
    begin
        First_Level_Map.Find (The_Table, Variable_Name,
                              The_First_Level_Item, Ok);
        The_Type := The_First_Level_Item.The_Type;
        The_Value := The_First_Level_Item.The_Value;
        Success := Ok;
    end Get_Variable_From_1;


    procedure Get_Variable_From_2 (Variable_Name : String;
                                   The_Type : out Symbol_Type;
                                   The_Value : out Natural;
                                   Success : out Boolean) is
        The_Second_Level_Item : Second_Level_Item;
        Ok : Boolean := False;
    begin
        Second_Level_Map.Find (Current_Second_Level_Map, Variable_Name,
                               The_Second_Level_Item, Ok);
        The_Type := The_Second_Level_Item.The_Type;
        The_Value := The_Second_Level_Item.The_Value;
        Success := Ok;
    end Get_Variable_From_2;


    procedure Set_Var_Type (Variable_Name : String; The_Type : Symbol_Type) is
        The_First_Level_Item : First_Level_Item;
        The_Second_Level_Item : Second_Level_Item;
        Ok : Boolean := False;
    begin
        if Current_Level = 1 then
            First_Level_Map.Find (The_Table, Variable_Name,
                                  The_First_Level_Item, Ok);
            if Ok then
                The_First_Level_Item.The_Type := The_Type;
                First_Level_Map.Define
                   (The_Table, Variable_Name, The_First_Level_Item);
            else
                Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
            end if;
        else
            Second_Level_Map.Find (Current_Second_Level_Map, Variable_Name,
                                   The_Second_Level_Item, Ok);
            if Ok then
                The_Second_Level_Item.The_Type := The_Type;
                Second_Level_Map.Define (Current_Second_Level_Map,
                                         Variable_Name, The_Second_Level_Item);
            else
                Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
            end if;
        end if;

    end Set_Var_Type;


    procedure Set_Parameter_Value
                 (Parameter_Number : Natural; The_Value : Natural := 0) is
        The_Second_Level_Item : Second_Level_Item;
        Iter : Second_Level_Map.Iterator;
        Ok, Success : Boolean := False;  
        S : String (1 .. 255);
        L : Natural;
    begin
        Text_Io.Put_Line (Natural'Image (Parameter_Number));
        Text_Io.Put_Line (Natural'Image (The_Value));
        Second_Level_Map.Init (Iter, Current_Second_Level_Map);
        while not (Second_Level_Map.Done (Iter) or Ok) loop
            declare
                Var_Name : constant String := Second_Level_Map.Value (Iter);
            begin
                L := Var_Name'Last;
                S (1 .. L) := Var_Name;
                Second_Level_Map.Find (Current_Second_Level_Map, Var_Name,
                                       The_Second_Level_Item, Success);
                if (The_Second_Level_Item.Parameter_Number =
                    Parameter_Number) then
                    Ok := True;
                else
                    Ok := False;
                end if;
                Second_Level_Map.Next (Iter);
            end;
        end loop;
        The_Second_Level_Item.The_Value := The_Value;
        Second_Level_Map.Define (Current_Second_Level_Map,
                                 S (1 .. L), The_Second_Level_Item);

    end Set_Parameter_Value;


    procedure Set_Var_Value (Variable_Name : String;
                             The_Value : Natural := 0) is
        The_First_Level_Item : First_Level_Item;
        The_Second_Level_Item : Second_Level_Item;
        Ok : Boolean := False;
    begin
        if Current_Level = 1 then
            First_Level_Map.Find (The_Table, Variable_Name,
                                  The_First_Level_Item, Ok);
            if Ok then
                The_First_Level_Item.The_Value := The_Value;
                First_Level_Map.Define
                   (The_Table, Variable_Name, The_First_Level_Item);
            else
                Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
            end if;
        else
            Second_Level_Map.Find (Current_Second_Level_Map, Variable_Name,
                                   The_Second_Level_Item, Ok);
            if Ok then
                The_Second_Level_Item.The_Value := The_Value;
                Second_Level_Map.Define (Current_Second_Level_Map,
                                         Variable_Name, The_Second_Level_Item);
            else
                Text_Io.Put_Line ("*** Erreur *** La Var n'existe pas");
            end if;
        end if;
    end Set_Var_Value;


    procedure Set_Function_Value
                 (Function_Name : String; The_Value : Natural := 0) is
        The_First_Level_Item : First_Level_Item;
        Ok : Boolean := False;
    begin
        First_Level_Map.Find (The_Table, Function_Name,
                              The_First_Level_Item, Ok);
        if Ok then
            The_First_Level_Item.The_Value := The_Value;
            First_Level_Map.Define
               (The_Table, Function_Name, The_First_Level_Item);
        else
            Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
        end if;
    end Set_Function_Value;


    procedure Set_Start_Point (Function_Name : String;
                               The_Node : Binary_Tree.Node) is
        The_First_Level_Item : First_Level_Item;
        Ok : Boolean := False;
    begin
        First_Level_Map.Find (The_Table, Function_Name,
                              The_First_Level_Item, Ok);
        if Ok then
            The_First_Level_Item.The_Node := The_Node;
            First_Level_Map.Define
               (The_Table, Function_Name, The_First_Level_Item);
        else
            Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
        end if;
    end Set_Start_Point;


    function Get_Function_Value (Function_Name : String) return Natural is
        The_First_Level_Item : First_Level_Item;
        Ok : Boolean := False;
    begin
        First_Level_Map.Find (The_Table, Function_Name,
                              The_First_Level_Item, Ok);
        if Ok then
            return The_First_Level_Item.The_Value;
        else
            Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
        end if;
    end Get_Function_Value;



    function Get_Start_Point (Function_Name : String) return Binary_Tree.Node is
        The_First_Level_Item : First_Level_Item;
        Ok : Boolean := False;
    begin
        First_Level_Map.Find (The_Table, Function_Name,
                              The_First_Level_Item, Ok);
        if Ok then
            return The_First_Level_Item.The_Node;  
        else
            Text_Io.Put_Line ("*** Erreur *** La fonction n'existe pas");
        end if;
    end Get_Start_Point;



    procedure Put (The_Item : Second_Level_Item) is
    begin
        Text_Io.Put (Symbol_Type'Image (The_Item.The_Type));
        Text_Io.Put ("     ");
        Text_Io.Put (Natural'Image (The_Item.The_Value));
        Text_Io.Put ("     ");
        Text_Io.Put (Natural'Image (The_Item.Parameter_Number));
    end Put;


    procedure Put (The_Item : First_Level_Item) is
        Second_Level_Iterator : Second_Level_Map.Iterator;
        The_Second_Level_Item : Second_Level_Item;
        Ok : Boolean;
    begin
        Text_Io.Put (Symbol_Type'Image (The_Item.The_Type));  
        Text_Io.Put ("     ");
        Text_Io.Put (Natural'Image (The_Item.The_Value));
        Text_Io.Put_Line ("");
        if not (Second_Level_Map.Is_Nil (The_Item.The_Table)) then
            Second_Level_Map.Init (Second_Level_Iterator, The_Item.The_Table);
            while not Second_Level_Map.Done (Second_Level_Iterator) loop
                Second_Level_Map.Find (The_Item.The_Table,
                                       Second_Level_Map.Value
                                          (Second_Level_Iterator),
                                       The_Second_Level_Item, Ok);
                Text_Io.Put ("          ");
                Text_Io.Put (Second_Level_Map.Value (Second_Level_Iterator));
                Text_Io.Put ("     ");
                Put (The_Second_Level_Item);
                Text_Io.Put_Line ("");
                Second_Level_Map.Next (Second_Level_Iterator);
            end loop;
        end if;
    end Put;



    procedure Put is
        First_Level_Iterator : First_Level_Map.Iterator;
        The_First_Level_Item : First_Level_Item;
        Ok : Boolean;
    begin
        Text_Io.Put_Line
           ("----------------- Debut de la Table des Symboles --------------------");
        First_Level_Map.Init (First_Level_Iterator, The_Table);
        while not First_Level_Map.Done (First_Level_Iterator) loop
            First_Level_Map.Find (The_Table,
                                  First_Level_Map.Value (First_Level_Iterator),
                                  The_First_Level_Item, Ok);  
            Text_Io.Put (First_Level_Map.Value (First_Level_Iterator));
            Text_Io.Put ("     ");
            Put (The_First_Level_Item);
            Text_Io.Put_Line ("");
            First_Level_Map.Next (First_Level_Iterator);
        end loop;
        Text_Io.Put_Line
           ("----------------- Fin de la Table des Symboles ----------------------");
    end Put;

end Symbol;