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

⟦a026b515f⟧ TextFile

    Length: 5582 (0x15ce)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

separate (Jacquet)
procedure Parse_Action (Validation_Bloc : in out Boolean; Ok : out Boolean) is
    Tmp_Id1, Tmp_Id2, Tmp_Val : Personnal_String.Pstring;
    Tmp_Token : Token.Object;

    function Parse_Action_5 return Boolean is
    begin
        if Token.Object'Pos (Lex.Lex_Get_Token) =
           Token.Object'Pos (Token.L_En) then
            Lex.Lex_Next;
            if Parse_Operande then
                if Tds.Mknode_Temporel (Tmp_Id1, Tmp_Id2, Tmp_Val,
                                        Tmp_Token, Lex.Lex_Get_Value,
                                        Lex.Lex_Get_Token) then
                    Lex.Lex_Next;
                    return True;
                else
                    return False;    -- Erreur dans le noeud Temporel
                end if;
            else
                Lex.Lex_Next;
                return False;       -- Erreur dans Parse_Operande
            end if;
        else
            return Tds.Mknode_Discret (Tmp_Id1, Tmp_Id2, Tmp_Val, Tmp_Token);
        end if;
    end Parse_Action_5;

    function Parse_Action_4 return Boolean is
    begin
        if Token.Object'Pos (Lex.Lex_Get_Token) =
           Token.Object'Pos (Token.L_Egal) then
            Lex.Lex_Next;
            if Parse_Operande then
                Tmp_Val := Lex.Lex_Get_Value;
                Tmp_Token := Lex.Lex_Get_Token;
                Lex.Lex_Next;
                return Parse_Action_5;
            else
                return False;
            end if;
        else
            return Tds.Mknode_Fugitif (Tmp_Id1, Tmp_Id2);
        end if;
    end Parse_Action_4;

    function Parse_Action_3 return Boolean is
    begin
        if Token.Object'Pos (Lex.Lex_Get_Token) =
           Token.Object'Pos (Token.L_Crochetg) then
            Lex.Lex_Next;
            if Tds.Set_Local_Group (Tmp_Id1) then
                if Parse_Liste_Groupe then
                    if Token.Object'Pos (Lex.Lex_Get_Token) =
                       Token.Object'Pos (Token.L_Crochetd) then
                        Lex.Lex_Next;
                        return True;
                    else
                        return False;   -- Oubli de crochet droit
                    end if;
                else
                    return False;      -- Erreur dans Parse_Liste_Groupe
                end if;
            else
                return False;         -- Erreur dans choix identificateur groupe
            end if;
        else
            if Tds.Set_Local_Variable (Tmp_Id1) then
                if Tds.Mknode_Eval (Tmp_Id1, Token.L_Id, Token.L_Egal) then
                    return Parse_Operation;  
                else
                    return False; -- Erreur dans creation du noeud evaluation
                end if;
            else
                return
                   False;    -- Erreur dans le choix identificateur d'Affectation.
            end if;
        end if;
    end Parse_Action_3;

    function Parse_Action_2 return Boolean is
    begin
        if Token.Object'Pos (Lex.Lex_Get_Token) =
           Token.Object'Pos (Token.L_Id) then
            Tmp_Id1 := Lex.Lex_Get_Value;
            Lex.Lex_Next;
            if Token.Object'Pos (Lex.Lex_Get_Token) =
               Token.Object'Pos (Token.L_Point) then
                Lex.Lex_Next;
                if Token.Object'Pos (Lex.Lex_Get_Token) =
                   Token.Object'Pos (Token.L_Id) then
                    return True;
                else
                    return False;       -- Acteur oublie
                end if;
            else
                return False;          -- Point oublie
            end if;
        else
            return False;             -- Station oubliee
        end if;
    end Parse_Action_2;

    function Parse_Action_1 return Boolean is
    begin
        case Lex.Lex_Get_Token is

            when Token.L_Egal =>
                Lex.Lex_Next;
                return Parse_Action_3;

            when Token.L_Point =>
                Lex.Lex_Next;
                if Token.Object'Pos (Lex.Lex_Get_Token) =
                   Token.Object'Pos (Token.L_Id) then
                    Tmp_Id2 := Lex.Lex_Get_Value;
                    Lex.Lex_Next;
                    return Parse_Action_4;
                else
                    return False;
                end if;

            when others =>
                return Parse_Liste_Param_Appel (Tmp_Id1);
        end case;
    end Parse_Action_1;

-- CORPS DE LA FONCTION PARSE ACTION

begin
    case Lex.Lex_Get_Token is

        when Token.L_Id =>
            Tmp_Id1 := Lex.Lex_Get_Value;
            Lex.Lex_Next;
            Ok := Parse_Action_1;

        when Token.L_Activer =>
            Lex.Lex_Next;
            if Parse_Action_2 then
                Ok := Tds.Mknode_Activer (Tmp_Id1, Lex.Lex_Get_Value);
            else
                Ok := False;
            end if;
            Lex.Lex_Next;

        when Token.L_Desactiver =>
            Lex.Lex_Next;
            if Parse_Action_2 then
                Ok := Tds.Mknode_Desactiver (Tmp_Id1, Lex.Lex_Get_Value);
            else
                Ok := False;
            end if;
            Lex.Lex_Next;

        when Token.L_Attendre =>
            Lex.Lex_Next;
            if Parse_Operande then
                Ok := Tds.Mknode_Attendre
                         (Lex.Lex_Get_Value, Lex.Lex_Get_Token);
            else
                Ok := False;
            end if;
            Lex.Lex_Next;

        when others =>
            Validation_Bloc := False;
            Ok := False;
    end case;
end Parse_Action;