DataMuseum.dk

top - download

    Length: 5569 (0x15c1)
    Types: TextFile
    Names: »B«

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

TextFile

with Lex, Error, Symbol, Debug, Intermediate_Code;
with Value;
package body Primitives is

    procedure Parse (N : in out Binary_Tree.Node; Success : in out Boolean) is
        N1 : Binary_Tree.Node;
        Ok : Boolean := True;
    begin  
        Success := True;
        N1 := new Binary_Tree.Node_Structure;
        case Lex.Get is
            when Lex.Activer =>
                Debug.Put (300);  
                N1.The_Type := Binary_Tree.Activer_Type;
                Lex.Next;
                if Lex.Current_Token_Is (Lex.Identifier) then
                    Debug.Put (301);
                    N1.S := new String'(Lex.Image);
                    Lex.Next;
                else
                    Error.Append (10);  
                    Success := False;
                end if;
            when Lex.Desactiver =>
                Debug.Put (302);  
                N1.The_Type := Binary_Tree.Desactiver_Type;
                Lex.Next;
                if Lex.Current_Token_Is (Lex.Identifier) then
                    Debug.Put (303);
                    N1.S := new String'(Lex.Image);
                    Lex.Next;
                else
                    Error.Append (10);
                    Success := False;
                end if;
            when Lex.Fixer =>
                Debug.Put (304);
                N1.The_Type := Binary_Tree.Fixer_Type;
                Lex.Next;
                if Lex.Current_Token_Is (Lex.Identifier) then
                    Debug.Put (305);
                    N1.S := new String'(Lex.Image);
                    Lex.Next;
                    if Lex.Current_Token_Is (Lex.A) then
                        Debug.Put (306);
                        Lex.Next;
                        Value.Parse (N1.Left_Son, Ok);
                        Success := Success and Ok;
                    else
                        Error.Append (12);
                        Success := False;
                    end if;
                else
                    Error.Append (10);
                    Success := False;
                end if;
            when Lex.Evoluer =>
                Debug.Put (307);
                N1.The_Type := Binary_Tree.Evoluer_Type;
                Lex.Next;
                if Lex.Current_Token_Is (Lex.Identifier) then
                    Debug.Put (308);  
                    N1.S := new String'(Lex.Image);
                    Lex.Next;
                    if Lex.Current_Token_Is (Lex.En) then
                        Debug.Put (309);
                        Lex.Next;
                        Value.Parse (N1.Left_Son, Ok);
                        if Lex.Current_Token_Is (Lex.A) then
                            Debug.Put (310);
                            Lex.Next;
                            Value.Parse (N1.Right_Son, Ok);
                            Success := Success and Ok;
                        end if;
                    else
                        Error.Append (13);
                        Success := False;  
                    end if;
                else
                    Error.Append (10);
                    Success := False;
                end if;
            when others =>
                Error.Append (15);
                Success := False;
        end case;
        N := N1;
    end Parse;


    procedure Generate_Activer (T : in out Natural;
                                Adress, Actor : in Natural) is
    begin
        Intermediate_Code.Put (Adress, Actor, T, 1);
    end Generate_Activer;


    procedure Generate_Desactiver (T : in out Natural;
                                   Adress, Actor : in Natural) is
    begin
        Intermediate_Code.Put (Adress, Actor, T, 0);
    end Generate_Desactiver;


    procedure Generate_Fixer (N : Binary_Tree.Node;
                              T : in out Natural;
                              Adress, Actor : in Natural) is
        Value : Natural;
        The_Type : Symbol.Symbol_Type;
        Ok : Boolean := True;
    begin
        Symbol.Get_Variable (N.Left_Son.S.all, The_Type, Value, Ok);
        Intermediate_Code.Put (Adress, Actor, T, Value);
    end Generate_Fixer;


    procedure Generate_Evoluer (N : Binary_Tree.Node;
                                T : in out Natural;
                                Adress, Actor : in Natural) is
        Value1, Value2 : Natural;
        The_Type : Symbol.Symbol_Type;
        Ok : Boolean := True;
    begin
        Symbol.Get_Variable (N.Left_Son.S.all, The_Type, Value1, Ok);
        Symbol.Get_Variable (N.Right_Son.S.all, The_Type, Value2, Ok);
        Intermediate_Code.Put (Adress, Actor, T, Value2, Value1);
    end Generate_Evoluer;


    procedure Generate
                 (N : Binary_Tree.Node; T : in out Natural; S : in String) is
        Adress, Actor : Natural;
        The_Type : Symbol.Symbol_Type;
        Ok : Boolean := True;
    begin  
        Debug.Put (44444);
        Actor := Symbol.Get_Actor_Value (S, N.S.all);
        case N.The_Type is
            when Binary_Tree.Activer_Type =>
                Generate_Activer (T, Symbol.Get_Theatre_Adress (S), Actor);
            when Binary_Tree.Desactiver_Type =>
                Generate_Desactiver (T, Symbol.Get_Theatre_Adress (S), Actor);
            when Binary_Tree.Fixer_Type =>
                Generate_Fixer (N, T, Symbol.Get_Theatre_Adress (S), Actor);
            when Binary_Tree.Evoluer_Type =>
                Generate_Evoluer (N, T, Symbol.Get_Theatre_Adress (S), Actor);
            when others =>
                null;
        end case;
    end Generate;

end Primitives;