excute.~pas

delphi编的pl0编译器

unit Excute;

interface
uses
  Defination,Main,YuFaFenXi,SanYuanShi,Result_Form,
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ToolWin,
  ImgList, ActnList, StdActns;


procedure interpret;
procedure SeeResult;

implementation


procedure interpret;               //解释执行程序
label again;
var
  p,b,t:integer;
  i:instruction;
  s:array[1..1000]of integer;
  fi:text;
  str1,str2:string;
  input_true:boolean;

  function base(l:integer):integer;
  var
    b1:integer;
  begin
    b1:=b;
    while l>0 do
    begin
      b1:=s[b1];
      l:=l-1;
    end;
    base:=b1;
  end;

begin

  chdir('C:\');
  assignfile(fi,'Temporary_Excute_Result.txt');
  rewrite(fi);
  closefile(fi);
  append(fi);

  str1:='程序输入窗口';
  str2:='请输入数据 :        ';
  input_true:=true;

  t:=0;
  b:=1;
  p:=0;
  s[1]:=0;
  s[2]:=0;
  s[3]:=0;
  repeat
    i:=code[p];
    inc(p);
    with i do
    case f of
      lit:
      begin
        inc(t);
        s[t]:=a;
      end;
      opr:
        case a of
          0:
          begin
            t:=b-1;
            p:=s[t+3];
            b:=s[t+2];
          end;
          1:
            s[t]:=-s[t];
          2:
          begin
            dec(t);
            s[t]:=s[t]+s[t+1];
          end;
          3:
          begin
            dec(t);
            s[t]:=s[t]-s[t+1];
          end;
          4:
          begin
            dec(t);
            s[t]:=s[t]*s[t+1];
          end;
          5:
          begin
            dec(t);
            s[t]:=s[t] div s[t+1];/////////////////////
          end;
          6:
            s[t]:=ord(odd(s[t]));
          8:
          begin
            dec(t);
            s[t]:=ord(s[t]=s[t+1]);
          end;
          9:
          begin
            dec(t);
            s[t]:=ord(s[t]<>s[t+1]);
          end;
          10:
          begin
            dec(t);
            s[t]:=ord(s[t]<s[t+1]);
          end;
          11:
          begin
            dec(t);
            s[t]:=ord(s[t]>=s[t+1]);
          end;
          12:
          begin
            dec(t);
            s[t]:=ord(s[t]>s[t+1]);
          end;
          13:
          begin
            dec(t);
            s[t]:=ord(s[t]<=s[t+1]);
          end;
          14:
          begin
     //       write(s[t]);
            write(fi,s[t]);
            dec(t);
          end;
          15:
          begin
       //     writeln;
            writeln(fi);
          end;
          16:
          begin
            inc(t);

  again:    try
              s[t]:=strtoint(inputbox(str1,str2,''))
            except
              application.MessageBox('输入不合法!'+chr(10)+chr(10)+chr(13)+'请重新输入',
                         'halcyon_jwei',mb_ok+mb_iconasterisk);



              input_true:=false;
            end;
            if input_true=false then
            begin
              input_true:=true;
              goto again;
            end;
          end;
        end;
      lod:
      begin
        inc(t);
        s[t]:=s[base(l)+a];
      end;
      sto:
      begin
        s[base(l)+a]:=s[t];
        dec(t);
      end;
      cal:
      begin
        s[t+1]:=base(l);
        s[t+2]:=b;
        s[t+3]:=p;
        b:=t+1;
        p:=a;
      end;
      int:
        t:=t+a;
      jmp:
        p:=a;
      jpc:
      begin
        if s[t]=0 then p:=a;
        dec(t);
      end;
    end
  until p=0;
  closefile(fi);
end;


procedure SeeResult;           //查看结果
var
  ret:integer;
  s:string;
  f:text;
begin
  
  chdir('C:\');
  assignfile(f,'Temporary_Excute_Result.txt');
  reset(f);
  while not eof(f) do
  begin
    readln(f,s);
    ResultForm.Memo1.Lines.Append(s);
  end;
  closefile(f);
  deletefile('Temporary_Excute_Result.txt');

  if ResultForm.Visible=false then
  begin
    ret:=Application.MessageBox('程序执行完毕！'+chr(10)+'是否查看执行结果？'+chr(10),
                         'halcyon_jwei',mb_yesno+MB_ICONQUESTION);
    if ret=6 then
      ResultForm.Show;
  end
  else ResultForm.BringToFront;
end;
end.