view/trunk/CellV.pas

unit CellV;

interface

uses CellG, SysUtils;

const
  ict = 1;
  ics = 2;
  lit = 3;
  lis = 4;
  lod = 5;
  los = 6;
  lda = 7;
  las = 8;
  sto = 9;
  sts = 10;
  cal = 11;
  ret = 12;
  dit = 13;
  dik = 14;
  jmp = 15;
  jpc = 16;
  arr = 17;
  adv = 18;
  opr = 19;

  neg = 20;
  _add = 21;
  ads = 22;
  _sub = 23;
  sus = 24;
  _mul = 25;
  mus = 26;
  _div = 27;
  dis = 28;

  eql = 29;
  eqs = 30;
  neq = 31;
  nes = 32;
  lss = 33;
  gtr = 34;
  leq = 35;
  geq = 36;
  lid = 37;
  lds = 38;
  sid = 39;
  sls = 40;
  sds = 41;
  sld = 42;
  ini = 43;
  ins = 44;
  _inc = 45;
  _dec = 46;
  lin = 47;
  lde = 48;
  prt = 49;
  prs = 50;
  prl = 51;
  stp = 52;

  MAXCODE = 200;
  MAXMEM = 2000;
  MAXREG = 500;
  MAXMOJI = 100;

type
  TInst = class
  private
    opCode: integer;
  public
    constructor Create(const op: integer);
    function toString: string; virtual;
  end;

  TInstAddr = class(TInst)
  private
    addr: TRaddr;
  public
    constructor Create(const op: integer; a: TRaddr);
    function toString: string; override;
  end;

  TInstRet = class(TInst)
  private
    level, pI, pS, modori: integer;
  public
    constructor Create(const op, l, pi, ps, m: integer);
    function toString: string; override;
  end;

  TInstCal = class(TInst)
  private
    level: integer;
    code: integer;
  public
    constructor Create(op, l, c: integer);
    function toString: string; override;
  end;

  TInstVal = class(TInst)
  private
    value: integer;
  public
    constructor Create(const op, v: integer);
    function toString: string; override;
  end;

  TStrVal = class(TInst)
  private
    value: string;
  public
    constructor Create(op: integer; v: string);
    function toString: string; override;
  end;

  TInstPC = class(TInst)
  private
    value: integer;
  public
    constructor Create(op, v: integer);
    function toString: string; override;
  end;

  TInstOp = class(TInst)
  private
    optr: integer;
  public
    constructor Create(const op, o: integer);
    function toString: string; override;
  end;

  TCellV = class
  private
    _cellG: TCellG;
    code: array [0..MAXCODE] of TInst;
    cIndex: integer;
    display, sdisplay: array [0..CellG.MaxLevel] of integer;
  public
    _cellK: TObject;
    pCode, pTrace: Boolean;
    stack: array [0..MAXMEM] of integer;
    sstack: array [0..MAXMOJI] of string;
    top: integer;
    tos: integer;
    pc: integer;
    o1, o2: integer;
    constructor Create(g: TCellG; c, t: Boolean);
    destructor Destroy; override;
    function genCodeT(const op, t: integer): integer;
    function genCodeA(const op: integer; a: TRaddr): integer;
    function genCodeV(const op, v: integer): integer;
    function genCodeP(op,v: integer): integer;
    function genCodeS(op: integer; v: string): integer;
    function genCodeO(const p: integer): integer;
    function genCodeC(l, c: integer): integer;
    function genCodeR: integer;
    function genCodeRV: integer;
    procedure checkMax;
    procedure backPatch(i, j: integer);
    procedure backPatchJ(const i: integer);
    procedure backPatchL(i, j, a: integer);
    procedure backBreak(const c: integer);
    procedure backCal(i, l, c: integer);
    procedure changeS(i, a: integer);
    function nextCode: integer;
    procedure printCode;
    procedure printExe;
    procedure error;
    procedure shokika;
    function execute: integer;
  end;

implementation

function codeName(const c: integer): string;
begin
  case c of
  ict:
        result:='ict';
  ics:
        result:='ics';
  lit:
        result:='lit';
  lis:
        result:='lis';
  lod:
        result:='lod';
  los:
        result:='los';
  cal:
        result:='cal';
  ret:
        result:='ret';
  dit:
        result:='dit';
  dik:
        result:='dik';
  jmp:
        result:='jmp';
  jpc:
        result:='jpc';
  arr:
        result:='arr';
  adv:
        result:='adv';
  sto:
        result:='sto';
  opr:
        result:='opr';
  neg:
        result:='neg';
  _add:
        result:='add';
  _sub:
        result:='sub';
  _mul:
        result:='mul';
  _div:
        result:='div';
  eql:
        result:='eql';
  eqs:
        result:='eqs';
  neq:
        result:='neq';
  nes:
        result:='nes';
  lss:
        result:='lss';
  gtr:
        result:='gtr';
  leq:
        result:='leq';
  geq:
        result:='geq';
  prt:
        result:='prt';
  prs:
        result:='prs';
  prl:
        result:='prl';
  sid:
        result:='sid';
  sld:
        result:='sld';
  sls:
        result:='sls';
  lid:
        result:='lid';
  lda:
        result:='lda';
  las:
        result:='las';
  ini:
        result:='ini';
  _inc:
        result:='inc';
  _dec:
        result:='dec';
  lin:
        result:='lin';
  lde:
        result:='lde';
  ads:
        result:='ads';
  sus:
        result:='sus';
  stp:
        result:='stp';
  lds:
        result:='lds';
  sds:
        result:='sds';
  else
        result:=inttostr(c);
  end;
end;

{ TInst }

constructor TInst.Create(const op: integer);
begin
        inherited Create;
        opCode:=op;
end;

function TInst.toString: string;
begin
        result:=codeName(opCode);
end;

{ TCellV }

procedure TCellV.backBreak(const c: integer);
var
  bc, t: integer;
begin
        bc:=c;
  while bc <> 0 do
  begin
        t:=(code[bc] as TInstPC).value;
        (code[bc] as TInstPC).value:=cIndex+1;
        bc:=t;
  end;
end;

procedure TCellV.backPatch(i, j: integer);
begin
        (code[i] as TInstPC).value:=_cellG.numAddr;
        (code[j] as TInstPC).value:=_cellG.snumAddr;
end;

procedure TCellV.backPatchJ(const i: integer);
begin
        (code[i] as TInstPC).value:=cIndex+1;
end;

procedure TCellV.backPatchL(i, j, a: integer);
begin
  if a = 0 then
  begin
        code[i].opCode:=lda;
  end else
  begin
        code[i].opCode:=las;
  end;
        (code[i] as TInstAddr).addr:=_cellG.tAddr(j);
end;

procedure TCellV.changeS(i, a: integer);
begin
  with code[i] as TInstOp do
  begin
  if a = 0 then
  begin
    if optr = sds then
    begin
        optr:=sid;
    end else
    begin
        optr:=sld;
    end;
  end else
  begin
    if optr = sid then
    begin
        optr:=sds;
    end else
    begin
        optr:=sls;
    end;
  end;
  end;
end;

procedure TCellV.checkMax;
begin
  if cIndex > MAXCODE then
  begin
        _cellG.error('�R�[�h�I�[�o�[�����B');
  end else
  begin
        inc(cIndex);
  end;
end;

constructor TCellV.Create(g: TCellG; c, t: Boolean);
begin
        inherited Create;
        _cellG:=g;
        pCode:=c;
        pTrace:=t;
        cIndex:=-1;
        shokika;
end;

destructor TCellV.Destroy;
begin
        shokika;
        inherited;
end;

procedure TCellV.error;
begin
        code[pc]:=TInstOp.Create(opr,stp);
end;

function TCellV.execute: integer;
var
  lev, m, m1, temp: integer;
  s1, s2, tems: string;
  t: TInst;
  p: string;
begin
        genCodeO(stp);
  if _cellG.exe = 0 then
  begin
        display[0]:=0;
        sdisplay[0]:=0;
  end;
        inc(_cellG.exe);
  if pCode = true then
  begin
        printCode;
        Writeln;
  end;
  if pTrace = true then
  begin
        Writeln('--- strat execution ---');
  end;
        temp:=0;
        tems:='';
        o1:=0;
        o2:=0;
  repeat
    if pTrace = true then
    begin
        printExe;
    end;
        t:=code[pc];
        o1:=t.opCode;
    case o1 of
    ict:
    begin
        inc(top,(t as TInstPC).value);
      if top >= MAXMEM-MAXREG then
      begin
        Writeln('�I�[�o�[�t���[�����B');
        error;
      end;
    end;
    lit:
    begin
        stack[top]:=(t as TInstVal).value;
        inc(top);
    end;
    lod:
    begin
        stack[top]:=stack[display[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr];
        inc(top);
    end;
    los:
    begin
        sstack[tos]:=sstack[sdisplay[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr];
        inc(tos);
    end;
    ics:
    begin
        inc(tos,(t as TInstPC).value);
      if tos >= MAXMEM-MAXMOJI then
      begin
                Writeln('�I�[�o�[�t���[�����B');
                error;
      end;
    end;
    lis:
    begin
        sstack[tos]:=(t as TStrVal).value;
        inc(tos);
    end;
    lda:
    begin
        stack[top]:=display[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr;
        inc(top);
    end;
    las:
    begin
        stack[top]:=sdisplay[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr;
        inc(top);
    end;
    sto:
    begin
        dec(top);
        stack[display[TInstAddr(t).addr.level]+TInstAddr(t).addr.addr]:=stack[top];
    end;
    sts:
    begin
        dec(tos);
        sstack[sdisplay[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr]:=sstack[tos];
    end;
    cal:
    begin
        lev:=(t as TInstCal).level+1;
        stack[top]:=display[lev];
        stack[top+1]:=sdisplay[lev];
        stack[top+2]:=pc+1;
        display[lev]:=top;
        sdisplay[lev]:=tos;
        pc:=(t as TInstCal).code;
        continue;
    end;
    ret:
    begin
        m:=(t as TInstRet).modori;
      if m = CellG._I then
      begin
                temp:=stack[top-1];
      end else
      begin
                tems:=sstack[tos-1];
      end;
        top:=display[(t as TInstRet).level];
        tos:=sdisplay[(t as TInstRet).level];
        display[(t as TInstRet).level]:=stack[top];
        sdisplay[(t as TInstRet).level]:=stack[top+1];
        pc:=stack[top+2];
        dec(top,(t as TInstRet).pI);
        dec(tos,(t as TInstRet).pS);
      if m = CellG._I then
      begin
                stack[top]:=temp;
                inc(top);
      end else
                if m = CellG._S then
      begin
                sstack[tos]:=tems;
                inc(tos);
      end;
        continue;
    end;
    dit:
    begin
        lev:=(t as TInstPC).value;
        stack[top]:=display[lev];
        stack[top+1]:=sdisplay[lev];
        display[lev]:=top;
        sdisplay[lev]:=tos;
    end;
    dik:
    begin
        lev:=(t as TInstPC).value;
        top:=display[lev];
        tos:=sdisplay[lev];
        display[lev]:=stack[top];
        sdisplay[lev]:=stack[top+1];
    end;
    jmp:
    begin
        pc:=(t as TInstPC).value;
        continue;
    end;
    jpc:
    begin
        dec(top);
      if stack[top] = 0 then
      begin
                pc:=(t as TInstPC).value;
                continue;
      end;
    end;
    arr:
    begin
        m:=stack[top-2];
        m1:=stack[top-1];
      if (m > TInstAddr(t).addr.level)or(m1 > TInstAddr(t).addr.addr) then
      begin
                Writeln('�z���I�[�o�[�����B');
                error;
      end;
        stack[top]:=TInstAddr(t).addr.level;
        stack[top-2]:=m*stack[top];
        stack[top-3]:=stack[top-3]+stack[top-2];
        stack[top-3]:=stack[top-3]+m1;
        dec(top,2);
    end;
    opr:
    begin
        o2:=TInstOp(t).optr;
      case o2 of
      neg:
      begin
                stack[top-1]:=-stack[top-1];
      end;
      _add:
      begin
                dec(top);
                stack[top-1]:=stack[top-1]+stack[top];
      end;
      _sub:
      begin
                dec(top);
                stack[top-1]:=stack[top-1]-stack[top];
      end;
      _mul:
      begin
                dec(top);
                stack[top-1]:=stack[top-1]*stack[top];
      end;
      _div:
      begin
                dec(top);
                stack[top-1]:=stack[top-1] div stack[top];
      end;
      eql:
      begin
                dec(top);
        if stack[top-1] = stack[top] then
        begin
                stack[top-1]:=1;
        end else
        begin
                stack[top-1]:=0;
        end;
      end;
      neq:
      begin
                dec(top);
        if stack[top-1] <> stack[top] then
        begin
                stack[top-1]:=1;
        end else
        begin
                stack[top-1]:=0;
        end;
      end;
      eqs:
      begin
        if CompareText(sstack[tos-2],sstack[tos-1]) = 0 then
        begin
                stack[top]:=1;
        end else
        begin
                stack[top]:=0;
        end;
                inc(top);
                dec(tos,2);
      end;
      nes:
      begin
        if CompareText(sstack[tos-2],sstack[tos-1]) = 1 then
        begin
                stack[top]:=1;
        end else
        begin
                stack[top]:=0;
        end;
                inc(top);
                dec(tos,2);
      end;
      lss:
      begin
                dec(top);
        if stack[top-1] < stack[top] then
        begin
                stack[top-1]:=1;
        end else
        begin
                stack[top-1]:=0;
        end;
      end;
      gtr:
      begin
                dec(top);
        if stack[top-1] > stack[top] then
        begin
                stack[top-1]:=1;
        end else
        begin
                stack[top-1]:=0;
        end;
      end;
      leq:
      begin
                dec(top);
        if stack[top-1] <= stack[top] then
        begin
                stack[top-1]:=1;
        end else
        begin
                stack[top-1]:=0;
        end;
      end;
      geq:
      begin
                dec(top);
        if stack[top-1] >= stack[top] then
        begin
                stack[top-1]:=1;
        end else
        begin
                stack[top-1]:=0;
        end;
      end;
      prt:
      begin
                dec(top);
                Writeln(IntToStr(stack[top]));
      end;
      prs:
      begin
                dec(tos);
                Writeln(sstack[tos]);
      end;
      prl:
                Writeln;
      ads:
      begin
                dec(tos);
                sstack[tos-1]:=sstack[tos-1]+sstack[tos];
      end;
      sus:
      begin
                dec(tos);
                s1:=sstack[tos-1];
                s2:=sstack[tos];
                temp:=Pos(s2,s1);
        if temp > 0 then
        begin
                Delete(s1,temp,Length(s2));
                sstack[tos-1]:=s1;
        end;
      end;
      mus:
      begin
                dec(top);
                s1:='';
                s2:=sstack[tos-1];
        for m:=1 to stack[top] do
        begin
                s1:=s1+s2;
        end;
                sstack[tos-1]:=s1;
      end;
      dis:
      begin
                s1:=sstack[tos-3];
                s2:=sstack[tos-2];
                m:=Pos(s2,s1);
        while m > 0 do
        begin
                Delete(s1,m,Length(s2));
                Insert(sstack[tos-1],s1,m);
                m:=Pos(s2,s1);
        end;
                sstack[tos-3]:=s1;
                dec(tos,2);
      end;
      ini:
      begin
                p:='';
        while _cellG.checkIn(p) = true do
        begin
                Writeln('�����������������������B');
                Write('>');
                Readln(p);
        end;
                stack[top]:=StrToInt(p);
                inc(top);
      end;
      ins:
      begin
                p:='';
                Write('>');
                Readln(p);
                sstack[tos]:=p;
                inc(tos);
      end;
      sid:
      begin
                stack[stack[top-2]]:=stack[top-1];
                dec(top,2);
      end;
      lid:
                stack[top-1]:=stack[stack[top-1]]; //
      lds:
      begin
                dec(top);
                sstack[tos]:=sstack[stack[top]];
                inc(tos);
      end;
      sld:
      begin
                dec(top);
                stack[stack[top-1]]:=stack[top];
                stack[top-1]:=stack[top];
      end;
      sls:
      begin
                dec(top);
                sstack[stack[top]]:=sstack[tos-1];
      end;
      sds:
      begin
                dec(top);
                dec(tos);
                sstack[stack[top]]:=sstack[tos];
      end;
      _inc:
      begin
                dec(top);
                inc(stack[top]);
      end;
      _dec:
      begin
                dec(top);
                dec(stack[top]);
      end;
      lin,lde:
      begin
                m:=stack[top-1];
        if o2 =lin then
        begin
                inc(stack[m]);
        end else
        begin
                dec(stack[m]);
        end;
                stack[top-1]:=stack[m];
      end;
      end;
    end;
    end;
        inc(pc);
  until o2 = stp;
        shokika;
        _cellG.shokika;
        _cellG.closeFile;
        pTrace:=false;
        pCode:=false;
        _cellG.pTable:=false;
end;

function TCellV.genCodeA(const op: integer; a: TRaddr): integer;
begin
        checkMax;
        code[cIndex]:=TInstAddr.Create(op,a);
        result:=cIndex;
end;

function TCellV.genCodeC(l, c: integer): integer;
begin
        checkMax;
        code[cIndex]:=TInstCal.Create(cal,l,c);
        result:=cIndex;
end;

function TCellV.genCodeO(const p: integer): integer;
begin
        checkMax;
        code[cIndex]:=TInstOp.Create(opr,p);
        result:=cIndex;
end;

function TCellV.genCodeR: integer;
begin
  if code[cIndex].opCode = ret then
  begin
        result:=cIndex;
        Exit;
  end;
        checkMax;
        code[cIndex]:=TInstRet.Create(ret,_cellG.bLevel,_cellG.funcParIs,_cellG.funcParSs,_cellG.funcModori);
        result:=cIndex;
end;

function TCellV.genCodeS(op: integer; v: string): integer;
begin
        checkMax;
        code[cIndex]:=TStrVal.Create(op,v);
        result:=cIndex;
end;

function TCellV.genCodeT(const op, t: integer): integer;
begin
        checkMax;
        code[cIndex]:=TInstAddr.Create(op,_cellG.tAddr(t));
        result:=cIndex;
end;

function TCellV.genCodeV(const op, v: integer): integer;
begin
        checkMax;
        code[cIndex]:=TInstVal.Create(op,v);
        result:=cIndex;
end;

function TCellV.nextCode: integer;
begin
        result:=cIndex+1;
end;

procedure TCellV.printCode;
var
  i: integer;
begin
        Writeln('--- code ---');
  for i:=0 to cIndex do
  begin
        Writeln(IntToStr(i)+' : '+code[i].toString);
  end;
end;

procedure TCellV.printExe;
begin
  if o1 = 0 then
  begin
        Exit;
  end else
        if o1 = -1 then
  begin
        Writeln;
        Exit;
  end else
        if o1 <> opr then
  begin
        Write(codeName(o1)+' : ');
  end;
  case o1 of
  ict:
        Writeln('Istack='+IntToStr(top));
  ics:
        Writeln('Sstack='+IntToStr(tos));
  lit,lod,lda,las,arr:
        Writeln('Istack='+IntToStr(top-1)+' : '+IntToStr(stack[top-1]));
  lis,los,lds:
        Writeln('Sstack='+IntToStr(tos-1)+' : '+sstack[tos-1]);
  sto:
        Writeln(IntToStr(stack[top]));
  ret,jmp,jpc:
        Writeln(IntToStr(pc));
  cal:
        Writeln(IntToStr(pc));
  dit,dik:
        Writeln;
  opr:
  begin
        Write(codeName(o2)+' : ');
    if o2 < ini then
    begin
        Writeln('Istack='+IntToStr(top-1)+' : '+IntToStr(stack[top-1]));
    end else
        if o2 < prt then
    begin
        Writeln(IntToStr(stack[top]));
    end else
    begin
        Writeln(sstack[tos]);
    end;
  end;
  else
        Writeln(IntToStr(o1));
  end;
end;

procedure TCellV.backCal(i, l, c: integer);
begin
        (code[i] as TInstCal).code:=c;
        (code[i] as TInstCal).level:=l;
end;

procedure TCellV.shokika;
var
  i: integer;
begin
  for i:=0 to cIndex do
  begin
        code[i].Free;
  end;
        cIndex:=-1;
        top:=0;
        tos:=0;
        pc:=0;
end;

function TCellV.genCodeP(op, v: integer): integer;
begin
        checkMax;
        code[cIndex]:=TInstPC.Create(op,v);
        result:=cIndex;
end;

function TCellV.genCodeRV: integer;
begin
  if code[cIndex].opCode = ret then
  begin
        result:=cIndex;
        Exit;
  end;
        checkMax;
        code[cIndex]:=TInstRet.Create(ret,_cellG.bLevel+1,_cellG.funcParIs,_cellG.funcParSs,_cellG.funcModori);
        result:=cIndex;
end;

{ TInstAddr }

constructor TInstAddr.Create(const op: integer; a: TRaddr);
begin
        inherited Create(op);
        addr:=a;
end;

function TInstAddr.toString: string;
begin
        result:=inherited toString+',addr='+IntToStr(addr.level)+IntToStr(addr.addr);
end;

{ TInstRet }

constructor TInstRet.Create(const op, l, pi, ps, m: integer);
begin
        inherited Create(op);
        level:=l;
        self.pI:=pi;
        self.pS:=ps;
        modori:=m;
end;

function TInstRet.toString: string;
begin
        result:=inherited toString+',level='+IntToStr(level)+',pI='+
                IntToStr(pI)+',modori='+cellG.hyouji(modori);
end;

{ TInstVal }

constructor TInstVal.Create(const op, v: integer);
begin
        inherited Create(op);
        value:=v;
end;

function TInstVal.toString: string;
begin
        result:=inherited toString+',value='+IntToStr(value);
end;

{ TInstOp }

constructor TInstOp.Create(const op, o: integer);
begin
        inherited Create(op);
        optr:=o;
end;

function TInstOp.toString: string;
begin
        result:=inherited toString+',optr='+codeName(optr);
end;

{ TStrVal }

constructor TStrVal.Create(op: integer; v: string);
begin
        inherited Create(op);
        value:=v;
end;

function TStrVal.toString: string;
begin
        result:=(inherited toString)+'.value='+value;
end;

{ TInstCal }

constructor TInstCal.Create(op, l, c: integer);
begin
        inherited Create(op);
        level:=l;
        code:=c;
end;

function TInstCal.toString: string;
begin
        result:=(inherited toString)+','+IntToStr(code);
end;

{ TInstPC }

constructor TInstPC.Create(op, v: integer);
begin
        inherited Create(op);
        value:=v;
end;

function TInstPC.toString: string;
begin
        result:=(inherited toString)+'.value'+IntToStr(value);
end;

end.