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

⟦013888779⟧ TextFile

    Length: 5327 (0x14cf)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Bounded_String, Statements, Object, Scanner, Tiny_Error,
     Block_Class, Easy_X, Message, Pen_Class, Turtle_Class, Date_Class,
     String_Class, Tiny_X, Counter, Statistic, Bug, Io_Exceptions;


package body Tiny_Talk is

    package Bs renames Bounded_String;

    Display : Message.Tiny_String;
    Program : Message.Tiny_String;

    function Get_Display return String is
    begin
        return Bs.Image (Display);
    end Get_Display;

    procedure Set_Display (To : String) is
    begin
        Bs.Copy (Display, To);
    end Set_Display;

    function Get_Program return String is
    begin
        return Bs.Image (Program);
    end Get_Program;

    procedure Set_Program (To : String) is
    begin
        Bs.Copy (Program, To);
    end Set_Program;

    procedure Run (The_Program : String;
                   On_Display : String;
                   Unparse : Boolean;
                   Statistics : Boolean) is
        Result : Object.Reference;
        Main_Node : Statements.Node := Statements.Empty_Node;
    begin
        Set_Display (On_Display);
        Set_Program (The_Program);
        Scanner.Open (The_Program);
        Scanner.Next;  
        Tiny_X.Open (The_Program);
        Turtle_Class.Create_Default;
        Pen_Class.Create_Default;  
        Date_Class.Create_Default;
        Statements.Parse (Main_Node);
        if Unparse then
            Statements.Unparse (Main_Node);
        end if;
        loop
            case Easy_X.Next_Event is
                when Easy_X.Update =>
                    Turtle_Class.Reset;
                    Pen_Class.Reset;
                    String_Class.Reset;
                    Counter.Start_General_Counter;
                    Result := Statements.Interpret (Main_Node, Result);
                    Counter.State_Message;
                when Easy_X.Button_Down =>
                    exit;
                when Easy_X.Button_Up =>
                    null;
            end case;
        end loop;

        if Statistics then  
            Statistic.Write;
        end if;
        Tiny_X.Close;
    exception

        when Bug.Undefined_Name_In_Symbol_Table =>
            Tiny_Error.Undefined_Name_In_Symbol_Table;

        when Bug.Id_String_Overflow | Bug.Too_Many_Strings =>
            Tiny_Error.String_Class_Full;

        when Bug.String_Large_Overflow =>
            Tiny_Error.String_Large_Overflow;

        when Bug.Search_No_String_Object =>
            Tiny_Error.Search_No_String_Object;

        when Bug.Unknown_String_Message =>
            Tiny_Error.Unknown_String_Message;

        when Bug.Missing_Point =>
            Tiny_Error.Missing_Point;

        when Bug.Missing_Right_Brace =>
            Tiny_Error.Missing_Right_Brace;

        when Bug.Missing_Reserved_Word =>
            Tiny_Error.Missing_Reserved_Word;

        when Bug.Mismatch_Arguments_List =>
            Tiny_Error.Mismatch_Arguments_List;

        when Bug.Missing_Right_Parentheses =>
            Tiny_Error.Missing_Right_Parentheses;

        when Bug.Not_Enough_Messages =>
            Tiny_Error.Not_Enough_Messages;

        when Bug.Too_Many_Messages =>
            Tiny_Error.Too_Many_Messages;

        when Bug.Too_Many_Blocks =>
            Tiny_Error.Too_Many_Blocks;

        when Bug.Block_Not_Found =>
            Tiny_Error.Block_Not_Found;

        when Bug.Unknown_Block_Message =>
            Tiny_Error.Unknown_Block_Message;

        when Bug.Unknown_Integer_Message =>
            Tiny_Error.Unknown_Integer_Message;

        when Bug.Unknown_Boolean_Message =>
            Tiny_Error.Unknown_Boolean_Message;

        when Bug.Unknown_Turtle_Message =>
            Tiny_Error.Unknown_Turtle_Message;

        when Bug.Too_Many_Turtles =>
            Tiny_Error.Turtle_Table_Full;

        when Bug.Unknown_Date_Message =>
            Tiny_Error.Unknown_Date_Message;

        when Bug.Unexpected_Action_On_Date =>
            Tiny_Error.Unexpected_Action_On_Date;

        when Bug.Unknown_Pen_Message =>
            Tiny_Error.Unknown_Pen_Message;

        when Bug.Too_Many_Pens =>
            Tiny_Error.Too_Many_Pens;

        when Bug.Unexpected_Object =>
            Tiny_Error.Incorrect_Object;

        when Bug.Too_Many_Keywords =>
            Tiny_Error.Too_Many_Keywords;

        when Bug.Not_Enough_Keywords =>
            Tiny_Error.Not_Enough_Keywords;

        when Bug.Missing_Identifier =>
            Tiny_Error.Missing_Identifier;

        when Bug.Unexpected_Token =>
            Tiny_Error.Unexpected_Token;

        when Bug.Mismatch_Type =>
            Tiny_Error.Mismatch_Type;

        when Bug.Mismatch_Message =>
            Tiny_Error.Mismatch_Message;

        when Bug.Too_Many_Includes =>
            Tiny_Error.Too_Many_Includes;

        when Io_Exceptions.Name_Error =>
            Tiny_Error.Bad_File_Name;

        when Easy_X.Fatal_Error =>
            Tiny_Error.Fatal_X;

        when Numeric_Error =>
            Tiny_Error.Numeric_Error;

        when Constraint_Error =>
            Tiny_Error.Out_Of_Range;

        when Program_Error =>  
            Tiny_Error.Internal_Error;

        when Storage_Error =>
            Tiny_Error.Out_Of_Memory;

        when Bug.Unexpected_Include_File_Name =>
            Tiny_Error.Unexpected_Include_File_Name;
    end Run;



end Tiny_Talk;