{$m $ff02,1,235233}
{$r-,s-,i-,f+}

program RUNFORTH (input, output);

uses
    crt, dos, graph, CAL, MUSIC, PRINTER;

  var
      buffer      : array[0..4007] of shortint; {inspector Frost said so.}
                                                {so they can easily make viruses for it i think.}
      dosx, dosy  : integer;
(*
  type
    TheConstruct = record
      Name     : string;
      Value    : string;
      R2       : real;
    end;
*)

type
  VariablesBuffer = array[0..65001] of byte;

var
  AVar           : ^VariablesBuffer;
  HighestVarPos  : longint;
  KP             : boolean;
  EOFILE         : boolean;

var
  Segment : word;

procedure SaveVariable (VarName : string; Value : string);
  var
(*    TheVar   : TheConstruct;*)
    Len      : byte;
    Temp     : string;
    IsString : boolean;
    IsReal   : boolean;
    R        : real;
    Found    : boolean;
    c        : longint;
  begin
    IsString:= pos ('$', VarName) > 0;
    IsReal:= not IsString;
    Len:= length (VarName);
    Found:= false;
    for c:= 0 to HighestVarPos+1 do begin
      move (AVar^[c], Temp[0], Len+1);
      if Temp = VarName then begin
        case IsReal of
          true:   begin
            R:= Evaluate (Value);
            move (R, AVar^[c + Len + 1], sizeof (real));
          end;
          false: move (Value[0], AVar^[c+Len + 1], 256);
        end;
        Found:= true;
        break;
      end;
    end;
    if (not Found) and (HighestVarPos < 64001-256*2) then begin
        move (VarName[0], AVar^[HighestVarPos], Len+1);
        inc (HighestVarPos, Len + 1);
        case IsReal of
          true:   begin
            R:= Evaluate (Value);
            move (R, AVar^[HighestVarPos], sizeof (real));
            inc (HighestVarPos, sizeof (real));
          end;
          false: begin
            move (Value[0], AVar^[HighestVarPos], 256);
            inc (HighestVarPos, 256);
          end;

        end;
    end;
  end;

function LoadVariable (VarName : string) : string;
  var
(*    TheVar   : TheConstruct;*)
    Len      : byte;
    Temp     : string;
    IsString : boolean;
    IsReal   : boolean;
    R        : real;
    Found    : boolean;
    Return   : string;
    c        : longint;
  begin
    IsString:= pos ('$', VarName) > 0;
    IsReal:= not IsString;
    Len:= length (VarName);
    Found:= false;
    for c:= 0 to HighestVarPos+1 do begin
      move (AVar^[c], Temp[0], Len+1);
      if Temp = VarName then begin
        case IsReal of
          true:   begin
            move (AVar^[c + Len + 1], R, sizeof (real));
            str (R, Return);
          end;
          false: move (AVar^[c+Len + 1], Return[0], 256);
        end;
        Found:= true;
        break;
      end;
    end;
    if Found then
       LoadVariable:= Return
    else
      if IsString then
        LoadVariable:= ''
          else
            LoadVariable:= '0';
  end;

procedure UpString0 (var Tekst : string);
  var
    c : integer;
  begin
    for c:= 1 to length (Tekst) do
      Tekst[c]:= UpCase (Tekst[c]);
  end;

function LowerCase (Tekst : string) : string;
  var
    VerSchil : integer;
    c        : integer;
  begin
    Verschil:= ord ('A') - ord ('a');
    for c:= 1 to length (Tekst) do
      if Tekst[c] in ['A'..'Z'] then
        Tekst[c]:= char (byte(Tekst[c]) - Verschil);
    LowerCase:= Tekst;
  end;

procedure CopyFile (Tekst, Tekst2 : string);
  var
    Buffer2: array[0..1025] of shortint;
    Size   : longint;
    F,F2   : file;
    c      : longint;
  begin
    {$I-}
    assign (F, Tekst);
    reset (F, 1);
    assign (F2, Tekst2);
    rewrite (F2, 1);
    Size:= filesize (F);
    for c:= 1 to Size div 1024 do begin
      blockread (F, Buffer2, 1024);
      blockwrite (F2, Buffer2, 1024);
    end;
    Size:= Size mod 1024;
    blockread (F, Buffer2, SIze);
    blockwrite (F2, Buffer2, Size);
    close (F);
    close (F2)
  end;

procedure SaveDosScreen;
  begin
     move (mem[$b800:0], buffer, 4000);
     dosx:= wherex;
     dosy:= wherey;
  end;

procedure RestoreDosScreen;
  begin
      textmode (co80);
      move (buffer, mem[$b800:0], 4000);
      gotoxy (dosx, dosy);
  end;

var
  GraphicsDriver, GraphicsMode : integer;

var
    STACK_MAX : integer;
    Stepping  : real;

type
    tLineRec = record
        Number : longint;
        Tekst  : string;
    end;

 type
     tWas = (EenGetal, EenTekst, Niks);

var
    TF                  : text;
    TFMode              : char;
    Ink, Paper          : integer;
    FORINDEX            : real;
    c2                  : longint; { Program runner Counter ... ... ... }
    pc, c               : integer;
    Expression          : string;
    tekst               : string;
    StackPtr            : integer;
    Stack               : array[-1..177+3] of real;
    TekstStackPtr       : integer;
    TekstStack          : array[-1..177+3] of string;
    Result              : string;
    Index               : integer;
    Token               : string;
    R                   : real;
    A, B                : real;
    Code                : integer;
    B2                  : boolean;
    Dummy               : real;
    I, J                : integer;
    Len                 : integer;
    Screen              : string;
    _Line               : array[0..577+3] of ^tLineRec;
    HeapStatus          : pointer;
    Stop                : boolean;
    ProgSize            : longint;

     Gisteren, EerGisteren : tWas;

  procedure Plot (X,Y,C : integer);
    begin
      setcolor (C);
      Circle (X,Y, 1);
    end;


procedure EGAVGADriver; external;
  {$L EGAVGA.OBJ}

(*
label
    LeaveForLoop;
*)

procedure UpString (var Tekst : string);
  var
      c, len : integer;
      Haakjes: boolean;
  begin
      c:= 1;
      len:= length (Tekst);
      Haakjes:= (Tekst[1] = '"');
      repeat
        if not Haakjes then Tekst[c]:= upcase (Tekst[c]);
        c:= c + 1;
        if Tekst[c] = '"' then Haakjes:= not Haakjes;
      until c>len;
  end;

function IsValue (tekst : string) : boolean;
  var
      c      : integer;
      Return : boolean;
  begin
      Return:= true;
      if Tekst='INDEX' then begin
        IsValue:= true;
        exit;
      end;
      if (length(Tekst)=1) and (Tekst[1] in ['+', '-']) then begin
         Return:= false;
         IsValue:= false;
         exit
      end;
      if Tekst[1] in ['+', '-'] then begin
          for c:= 2 to length (Tekst) do
             if not (Tekst[c] in ['0'..'9', '.', 'e', 'E']) then begin
                Return:= false;
                IsValue:= Return;
                exit
             end;
      end else
      for c:= 1 to length (Tekst) do
         if not (Tekst[c] in ['0'..'9', '.', 'e', 'E']) then begin
            Return:= false;
            IsValue:= Return;
            exit
         end;
      IsValue:= Return;
  end;

procedure Push (Value : real);
  begin
      if StackPtr < STACK_MAX then begin
         inc (StackPtr, 1);
         Stack[StackPtr]:= Value
      end;
  end;

function Pop : real;
  var
      Return : real;
  begin
     if StackPtr > -1 then begin
        Return:= Stack[StackPtr];
        dec (StackPtr, 1);
        Pop:= Return
     end;
  end;

procedure PushStr (Value : string);
  begin
      if TekstStackPtr < STACK_MAX then begin
         inc (TekstStackPtr);
         TekstStack[TekstStackPtr]:= Value
      end;
  end;

function PopStr : string;
  var
      Return : string;
  begin
     if TekstStackPtr > -1 then begin
        Return:= TekstStack[TekstStackPtr];
        dec (TekstStackPtr);
        PopStr:= Return
     end;
  end;

function NextToken : string;
  var
      Temp    : string;
      Say     : boolean;
  begin
     Temp:= '';
     while (Index <= Len) and (Expression[Index] = ' ') do
         inc (Index, 1);
     Say:= Expression[Index] = '"';
     while (Index <= Len) and (Say or (Expression[Index]<>#32)) do begin
        Temp:= Temp + Expression[Index];
        inc (Index, 1);
        if Expression[Index] = '"' then Say:= not Say
     end;
     NextToken:= Temp
  end;

var S : string;

procedure ExecuteCommand (Expr : string);
 var
     ch    : char;
     K,L   : longint;
     aa,bb : integer;
     Bw    : word;
     Bby   : byte;
 label
     Volgende;
 var
     h, m, _s, s100        : word;
     DummyR                : real;
     Dummy                 : string;
     S2                    : string;
     Temp                  : string;
     Count                 : real;
     SavedIndex            : integer;
     x, y                  : longint;
 begin
  Index:= 1;
  Expression:= Expr;
  Len:= length (Expression);
  KP:= false;
  repeat
      KP:= KeyPressed;
      Token:= nexttoken;
      UpString (Token);
      case (IsValue (Token)) of
         true: begin
            if Token = 'KEYPRESSED' then begin
              case KP of
                true   :  push (1);
                false  :  push (0);
              end;
              EerGisteren:= EenGetal;
              goto Volgende;
            end else
            if Token = 'EOF' then begin
              EOFILE:= eof (TF);
              case EOFILE of
                true : push (1);
                false: push (0);
              end;
              EerGisteren:= EenGetal;
              goto Volgende;
            end;
            if Token = 'INDEX' then begin
              R:= FORINDEX
            end else
              R:= Evaluate (Token);
            Push (R);
            EerGisteren:= EenGetal;
            goto Volgende;
         end;
         false: begin
            case Token[1] of
               '+': begin
                  A:= Pop;
                  B:= Pop;
                  Push (B + A);
                  EerGisteren:= EenGetal;
                  goto Volgende;
               end;
               '-': begin
                  A:= Pop;
                  B:= Pop;
                  Push (B-A);
                  EerGisteren:= EenGetal;
                  goto Volgende;
               end;
               '*': begin
                  A:= Pop;
                  B:= Pop;
                  Push (B * A);
                  EerGisteren:= EenGetal;
                  goto Volgende;
               end;
               '/': begin
                  A:= Pop;
                  B:= Pop;
                  if A <> 0 then
                      Push (B / A)
                          else begin
                              writeln ('division by zero');
                              ch:= readkey;
                              exit
                          end;
                  EerGisteren:= EenGetal;
                  goto Volgende;
               end;
               '^': begin
                  J:= round (Pop);
                  B:= Pop;
                  A:= B;
                  for i:= 2 to J do B:= B*A;
                  Push (B);
                  EerGisteren:= EenGetal;
                  goto Volgende;
               end;
               '=': begin
                  if (Gisteren=EenGetal) and (EerGisteren = EEnGetal) then begin
                      A:= Pop;
                      B:= Pop;
                      if B=A then Push (1) else Push (0);
                      EerGisteren:= EenGetal;
                      goto Volgende;
                  end else
                      if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
                          S:= PopStr;
                          S2:= PopStr;
                          if S2=S then Push (1) else Push (0);
                          EerGisteren:= EenGetal;
                          goto Volgende;
                      end;
               end;
               '<': begin
                  if (Gisteren=EenGetal) and (EerGisteren = EEnGetal) then begin
                      A:= Pop;
                      B:= Pop;
                      if B<A then Push (1) else Push (0);
                      EerGisteren:= EenGetal;
                      goto Volgende;
                  end else
                      if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
                          S:= PopStr;
                          S2:= PopStr;
                          if S2<S then Push (1) else Push (0);
                          EerGisteren:= EenGetal;
                          goto Volgende;
                      end;
               end;
               '>': begin
                  if Token[2]='=' then begin
                    if (Gisteren=EenGetal) and (EerGisteren = EEnGetal) then begin
                        A:= Pop;
                        B:= Pop;
                        if B>=A then Push (1) else Push (0);
                        EerGisteren:= EenGetal;
                        goto Volgende;
                    end else
                        if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
                            S:= PopStr;
                            S2:= PopStr;
                            if S2>=S then Push (1) else Push (0);
                            EerGisteren:= EenGetal;
                            goto Volgende;
                        end;
                  end else begin
                  if (Gisteren=EenGetal) and (EerGisteren = EEnGetal) then begin
                      A:= Pop;
                      B:= Pop;
                      if B>A then Push (1) else Push (0);
                      EerGisteren:= EenGetal;
                      goto Volgende;
                  end else
                      if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
                          S:= PopStr;
                          S2:= PopStr;
                          if S2>S then Push (1) else Push (0);
                          EerGisteren:= EenGetal;
                          goto Volgende;
                      end;
                  end;
               end;
            end;
         end;
      end;
      if Token = 'COPY' then begin
        S:= PopStr;
        S2:= PopStr;
        copyfile (S2, S);
        Goto Volgende
      end else
      if Token = 'STRCAT$' then begin
        S:= PopStr;
        S2:= PopStr;
        PushStr (S2 + S);
        EerGisteren:= EenTekst;
        goto Volgende
      end else
      if Token = 'INSTR' then begin
        S:= PopStr;
        S2:= PopStr;
        Push (pos (S2, S));
        EerGisteren:= EenGetal;
        goto Volgende
      end else
      if Token = 'SEGMENT' then begin
        Segment:= word (round (Pop));
        goto Volgende
      end else
      if Token = 'POKE' then begin
        Bby:= (round (Pop));
        Bw:= word (round (Pop));
        mem[Segment:Bw]:= Bby;
        goto Volgende
      end else
      if Token = 'PEEK' then begin
        Bw:= word (round (Pop));
        push (mem[Segment:Bw]);
        EerGisteren:= EenGetal;
        goto Volgende;
      end else
      if token = 'ASCII' then begin
        S:= PopStr;
        Push (byte (S[1]));
        Eergisteren:= EenGetal;
        goto Volgende
      end else
      if Token = 'CHR$' then begin
        Bby:= (round (Pop));
        PushStr (char (Bby));
        EerGisteren:= EenTekst;
        goto Volgende
      end else
      if token = 'ROUND' then begin
        Push (round (Pop));
        EerGisteren:= EenGetal;
        goto Volgende
      end else
      if Token = 'HOUR' then begin
        gettime (h,m,_s,s100);
        push (h);
        EerGisteren:= EenGetal;
        goto Volgende
      end else
      if Token = 'MINUTES' then begin
        gettime (h,m,_s,s100);
        push (m);
        EerGisteren:= EenGetal;
        goto Volgende
      end else
      if Token = 'SECONDS' then begin
        gettime (h,m,_s,s100);
        push (_s);
        EerGisteren:= EenGetal;
        goto Volgende
      end else
      if Token = 'SECONDS100' then begin
        gettime (h, m, _s, s100);
        push (s100);
        EerGisteren:= EenGetal;
        goto Volgende
      end else
      if Token = 'LOCATE' then begin
        K:= round (Pop);
        L:= round (Pop);
        gotoxy (L, K);
        goto Volgende
      end else
      if Token = 'SHELL' then begin
        S:= PopStr;
        swapvectors;
        exec (getenv ('COMSPEC'), '/C '+S);
        swapvectors;
        goto Volgende
      end else
      if (Token = 'REMEMBER') or (Token = 'MRC') or (Token = 'RECALL') then begin
        Token:= NextToken;
        if pos ('$', Token) > 0 then begin
          PushStr (LoadVariable (Token));
          EerGisteren:= EenTekst;
        end
          else begin
            S2:= LoadVariable (Token);
            R:= Evaluate (S2);
            Push (R);
            EerGisteren:= EenGetal;
          end;
        goto Volgende;
      end else
      if Token = 'VAR' then begin
        if EerGisteren = EenGetal then begin
          Token:= NextToken;
          R:= Pop;
          str (R, S2);
          SaveVariable (Token, S2);
        end else begin
          Token:= NextToken;
          S:= PopStr;
          SaveVariable (Token, S);
        end;
        goto Volgende
      end else
      if Token = '<>' then begin
        if (Gisteren=EenGetal) and (EerGisteren = EEnGetal) then begin
            A:= Pop;
            B:= Pop;
            if B<>A then Push (1) else Push (0);
            EerGisteren:= EenGetal;
            goto Volgende;
        end else
            if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
                S:= PopStr;
                S2:= PopStr;
                if S2<>S then Push (1) else Push (0);
                EerGisteren:= EenGetal;
                goto Volgende;
            end;
      end else
      if Token = '<=' then begin
        if (Gisteren=EenGetal) and (EerGisteren = EEnGetal) then begin
            A:= Pop;
            B:= Pop;
            if B<=A then Push (1) else Push (0);
            EerGisteren:= EenGetal;
            goto Volgende;
        end else
            if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
                S:= PopStr;
                S2:= PopStr;
                if S2<=S then Push (1) else Push (0);
                EerGisteren:= EenGetal;
                goto Volgende;
            end;
      end else
      if Token = '>=' then begin
        if (Gisteren=EenGetal) and (EerGisteren = EEnGetal) then begin
            A:= Pop;
            B:= Pop;
            if B>=A then Push (1) else Push (0);
            EerGisteren:= EenGetal;
            goto Volgende;
        end else
            if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
                S:= PopStr;
                S2:= PopStr;
                if S2>=S then Push (1) else Push (0);
                EerGisteren:= EenGetal;
                goto Volgende;
            end;
      end else
      if Token = 'INPUT' then begin
         readln (s);
         if IsValue (S) then begin
           R:= Evaluate (S);
           Push (R);
           EerGisteren:= EenGetal;
         end else
           begin
             PushStr (S);
             EerGisteren:= EenTekst;
           end;
         goto Volgende;
      end else
      if Token='OPEN' then begin
        if upcase (TFMode) = 'C' then begin
          S:= PopStr;
          S2:= PopStr;
          assign (TF, S);
          while (S2[1]= ' ') do delete (S2, 1, 1);
          if upcase (S2[1]) = 'R' then begin
            TFMode:= 'R';
            reset (TF);
          end
            else if upcase (S2[1]) = 'W' then begin
              TFMode:= 'W';
              rewrite (TF);
            end;
        end;
        goto Volgende;
      end else
      if Token = 'CLOSE' then begin
        {$I-}
        if upcase (TfMode) in ['R', 'W'] then close (Tf);
        TfMode:= 'C';
        goto Volgende;
      end else
      if Token = 'READ' then begin
        if upcase (TFMode) = 'R' then begin
          readln (TF, S2);
          if IsValue (S2) then begin
            val (S2, R, Code);
            Push (R);
            EerGisteren:= EenGetal;
          end
            else begin
              PushStr (S2);
              EerGisteren:= EenTekst;
            end;
        end;
        goto Volgende;
      end else
      if Token = 'WRITE' then begin
        if upcase (TFMode) = 'W' then begin
          if Gisteren = EenGetal then begin
            R:= Pop;
            writeln (TF, R : 11 : 4);
          end
            else begin
              writeln (TF, PopStr);
            end;
        end;
        goto Volgende;
      end else
      if Token='INK' then begin
        Ink:= round (Pop);
        goto Volgende;
      end else
      if Token='PAPER' then begin
        Paper:= round (Pop);
        goto Volgende;
      end else
      if Token = 'CLS' then begin
        if screen = 'text' then begin
          textbackground (paper);
          textcolor (ink);
          clrscr;
        end
          else begin
            setbkcolor (paper);
            cleardevice;
            setcolor (ink);
          end;
        goto Volgende;
      end else
      if (Token='PLAY') then begin
        PlayMusicForeGround (PopStr);
        MusicOff;
        goto Volgende;
      end else
      if (Token='ZERO') or (Token='FLUSH') or (Token = 'OUT') or
        (Token = 'TAKEAWAY') then begin
        if Gisteren=EenGetal then
          DummyR:= Pop
            else
              Dummy:= PopStr;
        goto Volgende;
      end else
      if Token='WAITKEY$' then begin
        repeat
        until keypressed;
        Ch:= readkey;
        S2:= PopStr;
        while (S2[1]=' ') do delete (S2, 1, 1);
        if S2[1] = CH then
          Push (1)
            else
              Push (0);
        EerGisteren:= EenGetal;
        goto Volgende
      end else
      if Token='INKEY$' then begin
        CH:= readkey;
        PushStr (CH);
        EErgisteren:= EenTekst;
        goto Volgende;
      end else
      if Token='WAIT' then begin
        repeat
        until keypressed;
        goto Volgende;
      end else
      if (Token='BEEP') or (Token='SOUND') then begin
        A:= Pop;
        B:= Pop;
        sound (round (B));
        delay (round (A));
        nosound;
        goto Volgende;
      end else
      if (Token = 'PAUSE') or (Token = 'PAUZE') or (Token = 'DELAY') then begin
        A:= Pop;
        delay (round (A));
      end;
      if Token='FOR' then begin
         A:= Pop;
         B:= Pop;
         S2:= copy (Expression, pos('FOR', Expression)+3, 255);
         Count:= B;
         repeat
            FORINDEX:= Count;
            ExecuteCommand (S2);
            Count:= Count + Stepping
         until Count > A;
         Index:= length (S2);
         goto Volgende;
      end else
      if Token='STEP' then begin
         A:= Pop;
         Stepping:= A;
         goto Volgende;
      end else
      if Token='SWAP' then begin
        if (Gisteren=EenTekst) and (EerGisteren = EenTekst) then begin
          S:= PopStr;
          S2:= PopStr;
          PushStr (S);
          PushStr (S2);
          EerGisteren:= EenTekst;
        end else begin
          A:= Pop;
          B:= Pop;
          Push (A);
          Push (B);
          EerGisteren:= EenGetal;
        end;
        goto Volgende
      end else
      if Token='DUP' then begin
          if (Gisteren=EenTekst) then begin
              S:= PopStr;
              PushStr (S);
              PushStr (S);
              EerGisteren:= EenTekst;
          end else begin
              A:= Pop;
              Push (A);
              Push (A);
              EerGisteren:= EenGetal;
          end;
          goto Volgende;
      end else
      if Token='NOT' then begin
                      A:= Pop;
                      if (A=1) then Push (0) else Push (1);
                      EerGisteren:= EenGetal;
                      goto Volgende;
      end else
      if Token='AND' then begin
         A:= Pop;
         B:= Pop;
         if (A=1) and (B=1) then Push (1) else Push (0);
         EerGisteren:= EenGetal;
         goto Volgende;
      end else
      if Token='OR' then begin
         A:= Pop;
         B:= Pop;
         if (A=1) or (B=1) then Push (1) else Push (0);
         EerGisteren:= EenGetal;
         goto Volgende;
      end else
      if (Token='.S') or (Token='.PRINT') or (Token='PRINT') then begin
        if Gisteren = EenGetal then begin
            if screen='text' then begin
              textbackground (paper);
              textcolor (ink);
              writeln (Pop : 11 : 4);
            end
              else begin
                str (Pop : 11 : 4, S2);
                setcolor (Ink);
                writeln (S2);
              end;
        end
                else begin
                  if screen='text' then begin
                    textbackground (paper);
                    textcolor (ink);
                    writeln (PopStr);
                  end else begin
                    setcolor (ink);
                    writeln (PopStr);
                  end;
                end;
        goto Volgende;
      end else
      if (Token='LPRINT') or (Token='.LPRINT') then begin
        if Gisteren = EenGetal then begin
            if screen='text' then begin
              textbackground (paper);
              textcolor (ink);
              writeln (Lst, Pop : 11 : 4);
            end
              else begin
                str (Pop : 11 : 4, S2);
                setcolor (Ink);
                writeln (Lst, S2);
              end;
        end
                else begin
                  if screen='text' then begin
                    textbackground (paper);
                    textcolor (ink);
                    writeln (Lst, PopStr);
                  end else begin
                    setcolor (ink);
                    writeln (Lst, PopStr);
                  end;
                end;
        goto Volgende;
      end else
      if Token='SIN' then begin
         A:= Pop;
         Push (sin(A));
         EerGisteren:= EenGetal;
         goto Volgende;
      end else
      if Token='COS' then begin
         A:= Pop;
         Push (cos(A));
         EerGisteren:= EenGetal;
         goto Volgende;
      end else
      if Token='TAN' then begin
         A:= Pop;
         B:= Pop;
         if cos(A) <> 0 then begin
            Push (sin(B) / cos(A))
         end
            else begin
                writeln ('division by zero');
                ch:= readkey;
                exit
            end;
         EerGisteren:= EenGetal;
         goto Volgende;
      end else
        if Token='UCASE$' then begin
          S:= PopStr;
          UpString0 (S);
          PushStr (S);
          EerGisteren:= EenTekst;
          goto Volgende;
        end else
        if Token='LCASE$' then begin
          S:= PopStr;
          S:= LowerCase (S);
          PushStr (S);
          EerGisteren:= EenTekst;
          goto Volgende;
        end else
        if Token='MID$' then begin
           I:= round (Pop);
           J:= round (Pop);
           S:= PopStr;
           if I<0 then
               PushStr (copy (S, J+I+1, abs (I)))
                   else
                       PushStr (copy (S, J, I));
           EerGisteren:= EenTekst;
           goto Volgende;
        end else
        if Token='RIGHT$' then begin
           I:= round (Pop);
           S:= PopStr;
           PushStr (copy (S, length(S)-I+1, 255));
           EerGisteren:= EenTekst;
           goto Volgende;
        end else
        if Token='LEFT$' then begin
           I:= round (Pop);
           S:= PopStr;
           PushStr (copy (S, 1, I));
           EerGisteren:= EenTekst;
           goto Volgende;
        end else
        if Token='LEN' then begin
           S:= PopStr;
           Push (length(S));
           EerGisteren:= EenGetal;
           goto Volgende;
        end else
        if (Token='TEXTMODE') or (Token = 'TEXT') or (Token = 'TEXTMODUS') then begin
          TextMode (co80);
          textbackground (black);
          textcolor (lightgray);
          clrscr;
          if screen = 'vga' then
            RestoreDosScreen;
          screen:= 'text';
          goto Volgende;
        end else
        if (Token='VGA') then begin
           SaveDosScreen;
           GraphicsDriver:= vga;
           GraphicsMode:= vGAhi;
           initgraph (GraphicsDriver, GraphicsMode, '');
           directvideo:= false;
           Screen:= 'vga';
           goto Volgende;
        end else
        if Token='CIRCLE' then begin
           I:= round(Pop);
           J:= round (Pop);
           K:= round (Pop);
           if Screen = 'vga' then begin
             setcolor (Ink);
             circle (K, J, I);
           end;
           goto Volgende;
       end else
        if Token='LINE' then begin
           I:= round(Pop);
           J:= round (Pop);
           K:= round (Pop);
           L:= round (Pop);
           if Screen = 'vga' then begin
             setcolor (Ink);
             line (L, K, J, I);
           end;
           goto Volgende;
       end else
        if (Token='GETPIXEL') then begin
          Aa:= round (POP);
          Bb:= round (POP);
          I:= getpixel (Bb, Aa);
          Push (I);
          EerGisteren:= EenGetal;
          goto Volgende;
        end else
        if (Token='PIXEL') or (Token = 'POINT') or (Token='PLOT') or (Token='PUTPIXEL') then begin
           J:= round (Pop);
           K:= round (Pop);
           if Screen = 'vga' then begin
             setcolor (Ink);
             PutPixel (K,J, Ink);
           end;
           goto Volgende;
       end else
        if Token='IF' then begin
           R:= (Pop);
           S2:= '';
           S:= '';
           S:= Expression;
           delete (S, 1, pos ('IF', S)+1);
           if pos ('ELSE', S) > 0 then
             begin
                S2:= copy (S, pos ('ELSE', S)+4, 255);
                delete (S, pos('ELSE', S), 255);
             end;
           if R=1 then begin
              Expression:= S;
              Index:= 1;
              Len:= length (Expression);
              goto Volgende;
           end
             else begin
               Expression:= S2;
               Index:= 1;
               Len:= length (Expression);
               goto Volgende;
             end;
           goto Volgende;
        end else
        if Token='IFKEY' then begin
           if keypressed then R:= 1 else R:= 0;
           S2:= '';
           S:= '';
           S:= Expression;
           delete (S, 1, pos ('IFKEY', S)+4);
           if pos ('ELSE', S) > 0 then
             begin
                S2:= copy (S, pos ('ELSE', S)+4, 255);
                delete (S, pos('ELSE', S), 255);
             end;
           if R=1 then begin
              ExecuteCommand (S);
           end
             else
               ExecuteCommand (S2);
           goto Volgende;
        end else
        if Token = 'GOTO' then begin
            I:= round (Pop);
            for j:= 0 to ProgSize do begin
               if I = _Line[j]^.Number then begin
                   c2:= j-1;
                   exit
               end;
            end;
            goto Volgende;
        end else
        if (Token = 'STOP') or (Token = 'END') or (Token = 'SYSTEM') then begin
            Stop:= true;
            goto Volgende;
        end
        else
        if (Token = 'VAL') then begin
          S:= PopStr;
          Push (Evaluate (S));
          EerGisteren:= EenGetal;
          goto Volgende;
        end else
        if (Token = 'RND') or (Token = 'RANDOM') then begin
          Push (Random (round (Pop)));
          EerGisteren:= EenGetal;
          goto Volgende;
        end else
        if (Token = 'RANDOMISE') or (Token = 'RANDOMIZE') then begin
          Randomize;
          goto Volgende;
        end else if pos ('"', Token) > 0 then
      begin
         while (pos('"', Token) > 0) do
             delete (Token, pos('"', Token), 1);
         PushStr (Token);
         EerGisteren:= EenTekst;
         goto Volgende;
      end;
      Volgende:;
      Gisteren:= EerGisteren;
  until Token = '';
 end;

 var
     Command : string;

procedure ExecuteProgram;
    begin
        Screen:= 'text';
        STACK_MAX:= 177;
        StackPtr:= -1;
        TekstStackPtr:= -1;
        c2:= 0;
        Stop:= false;
        Stepping:= 1;
        FORINDEX:= 0;
        Eergisteren:= Niks;
        Gisteren:= Niks;
        Ink:= LIGHTGRAY;
        PAPER:= BLACK;
        TFMode:= 'C';
        fillchar (AVar^[0], 64001, 0);
        HighestVarPos:= 0;
        Segment:= $B800;
        repeat
            ExecuteCommand (_Line[c2]^.Tekst);
            inc (c2, 1);
        until (c2 > ProgSize) or (c2 < 0) or stop;
    end;


var
  MyName                : string;
  MyPath                : string;
  ProgSize2,FSize       : longint;
  F                     : file;

const
  MY_SIZE = 60672;

begin
   nosound;
   Mark (HeapStatus);
   new (AVAR);
   if RegisterBGIdriver(@EGAVGADriver) < 0 then
   begin
     WriteLn('Error registering driver: ',
             GraphErrorMsg(GraphResult));
     Halt(1);
   end;
   for c:= 0 to 577 do begin
     new (_Line[c]);
     _Line[c]^.Number:= 100 + c*10;
     _Line[c]^.Tekst:= '';
   end;
   ProgSize:= 0;
   Screen:= 'text';
   STACK_MAX:= 177;
   StackPtr:= -1;
   TekstStackPtr:= -1;
   fillchar (AVar^[0], 64001, 0);
   HighestVarPos:= 0;

   getdir (0, MyPath);
   MyName:= paramstr (0);
   assign (F, MyName);
   reset (F, 1);
   FSize:= filesize (F);
   ProgSize2:= FSize - MY_SIZE;
   seek (F, My_Size);
   if ProgSize2 div 256 > 577 then begin
     close (F);
     halt (17)
   end;
   for c:= 0 to ProgSize2 div 256-1 do
     blockread (F, _Line[c]^.Tekst[0], 256);
   close (F);

   ProgSize:= ProgSize2 div 256 -1;
   ExecuteProgram;

   Release (HeapStatus);
   MusicOff;
end.
+
+
+
+
