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 - metrics - download

⟦72c43e97a⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Interprete, seg_0422c7

Derivation

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

with Text_Io, Bounded_String, Lex_Player;

package body Interprete is


    Max_Player_Entry : constant Positive := 3;
    subtype Iterator is Integer range 1 .. Max_Player_Entry + 1;

    type Error_List is (No_Error, Caractere_Invalide,
                        Trop_De_Parametres, Commande_Erronee,
                        Commande_Inconnue, Saisie_Trop_Longue);


    subtype Preposition is Token range Start_Prep .. End_Prep;
    subtype Commande is Token range Start_Com .. End_Com;

    type Entry_Element is
        record
            A_Token : Token;
            A_String : Bounded_String.Variable_String
                          (Lex_Player.Max_Player_String);
        end record;
    Entry_Table : array (1 .. Max_Player_Entry) of Entry_Element;
    The_Index : Iterator;

    function Is_Keyword (The_String : in String) return Boolean is
        T : Token;
    begin
        T := Token'Value (The_String);
        return True;
    exception
        when Constraint_Error =>
            return False;
    end Is_Keyword;



    function Keyword_To_Token (Word : in String) return Token is
    begin
        if Is_Keyword (Word) then
            return Token'Value (Word);
        else
            return Id;
        end if;
    end Keyword_To_Token;


    procedure Init_Entry_Table is
    begin
        for I in Entry_Table'Range loop
            Entry_Table (I).A_Token := End_Entry;
            Bounded_String.Free (Entry_Table (I).A_String);
        end loop;
    end Init_Entry_Table;

    procedure Put_Entry_Status (Error_Id : in Error_List) is
    begin
        if (Error_Id /= No_Error) then
            Text_Io.Put_Line (Ascii.Bel & "Erreur : " &
                              Error_List'Image (Error_Id) & " !!!");
        end if;
    end Put_Entry_Status;

    procedure Print_Player_Entry is
    begin
        Print_Loop:
            for I in Entry_Table'Range loop
                if not (Entry_Table (I).A_Token = End_Entry) then

                    Text_Io.Put_Line (Token'Image (Entry_Table (I).A_Token) &
                                      " -> " & Bounded_String.Image
                                                  (Entry_Table (I).A_String));
                else
                    Text_Io.Put_Line (Token'Image (Entry_Table (I).A_Token));

                    exit Print_Loop;
                end if;
            end loop Print_Loop;
    end Print_Player_Entry;

    procedure Insert_Player_Token
                 (Table_Index : in Positive; Token_Found : in Token) is
    begin
        Entry_Table (Table_Index).A_Token := Token_Found;
    end Insert_Player_Token;

    procedure Insert_Player_Entry
                 (Table_Index : in Positive; Str_Found : in String) is
    begin
        Bounded_String.Copy (Entry_Table (Table_Index).A_String, Str_Found);
    end Insert_Player_Entry;


    function Analyse_Player_Entry return Error_List is
        The_Index : Positive := Entry_Table'First;

        T1 : Lex_Player.Token;
        T2 : Token;

    begin
        Lex_Player.Get_Player ("Commande >>");
        Lex_Player.Init;


        Analyse:
            while not (Lex_Player.At_End) loop
                Lex_Player.Next;
                T1 := Lex_Player.Get_Token;
                case T1 is
                    when Lex_Player.Lexend =>
                        exit Analyse;
                    when Lex_Player.Unk =>
                        Insert_Player_Token (Entry_Table'First, End_Entry);
                        return (Caractere_Invalide);
                    when Lex_Player.Toolong =>
                        Insert_Player_Token (Entry_Table'First, End_Entry);
                        return (Saisie_Trop_Longue);
                    when Lex_Player.Id =>
                        T2 := Keyword_To_Token (Lex_Player.Get_Value);
                        if (The_Index > Max_Player_Entry) then
                            Insert_Player_Token (Entry_Table'First, End_Entry);
                            return (Trop_De_Parametres);
                        elsif (T2 not in Preposition) then
                            Insert_Player_Token (The_Index, Id);
                            Insert_Player_Entry (The_Index,
                                                 Lex_Player.Get_Value);
                            The_Index := The_Index + 1;
                        end if;
                    when Lex_Player.Command =>
                        T2 := Keyword_To_Token (Lex_Player.Get_Value);
                        if (The_Index /= Entry_Table'First) then
                            Insert_Player_Token (Entry_Table'First, End_Entry);
                            return (Commande_Erronee);
                        elsif (T2 not in Commande) then
                            Insert_Player_Token (Entry_Table'First, End_Entry);
                            return (Commande_Inconnue);
                        else
                            Insert_Player_Token (The_Index, T2);
                            Insert_Player_Entry (The_Index,
                                                 Lex_Player.Get_Value);
                            The_Index := The_Index + 1;
                        end if;
                end case;
            end loop Analyse;
        return No_Error;
    end Analyse_Player_Entry;


    procedure Get_Player_Entry is
    begin
        Init_Entry_Table;
        Put_Entry_Status (Interprete.Analyse_Player_Entry);
    end Get_Player_Entry;


    procedure Open_Index is
    begin
        The_Index := Iterator'First;
    end Open_Index;

    procedure Next_Index is
    begin
        if The_Index < Iterator'Last then
            The_Index := The_Index + 1;
        else
            raise Error_Range_Interprete;
        end if;
    end Next_Index;

    function Get_Indexed_Token return Token is
    begin
        return (Entry_Table (The_Index).A_Token);
    end Get_Indexed_Token;

    function Get_Indexed_Entry return String is
    begin
        return Bounded_String.Image (Entry_Table (The_Index).A_String);
    end Get_Indexed_Entry;

    function Index_At_End return Boolean is
    begin
        return (The_Index > Max_Player_Entry);
    end Index_At_End;


end Interprete;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=20 rec1=00 rec2=01 rec3=01a
        [0x01] rec0=25 rec1=00 rec2=02 rec3=010
        [0x02] rec0=1a rec1=00 rec2=03 rec3=03e
        [0x03] rec0=1a rec1=00 rec2=04 rec3=050
        [0x04] rec0=10 rec1=00 rec2=05 rec3=036
        [0x05] rec0=22 rec1=00 rec2=06 rec3=036
        [0x06] rec0=11 rec1=00 rec2=07 rec3=001
    tail 0x2153d2936862972b2cea1 0x42a00088462060003