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
    code[i].opCode := lda
  else
    code[i].opCode := las;
  (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
      if optr = sds then
        optr := sid
      else
        optr := sld
    else if optr = sid then
      optr := sds
    else
      optr := sls;
  end;
end;

procedure TCellV.checkMax;
begin
  if cIndex > MAXCODE then
    _cellG.error('�R�[�h�I�[�o�[�����B')
  else
    inc(cIndex);
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
    Writeln('--- strat execution ---');
  temp := 0;
  tems := '';
  o1 := 0;
  o2 := 0;
  repeat
    if pTrace = true then
      printExe;
    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
            temp := stack[top - 1]
          else
            tems := sstack[tos - 1];
          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:
              stack[top - 1] := -stack[top - 1];
            _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
                  stack[top - 1] := 1
                else
                  stack[top - 1] := 0;
              end;
            neq:
              begin
                dec(top);
                if stack[top - 1] <> stack[top] then
                  stack[top - 1] := 1
                else
                  stack[top - 1] := 0;
              end;
            eqs:
              begin
                if CompareText(sstack[tos - 2], sstack[tos - 1]) = 0 then
                  stack[top] := 1
                else
                  stack[top] := 0;
                inc(top);
                dec(tos, 2);
              end;
            nes:
              begin
                if CompareText(sstack[tos - 2], sstack[tos - 1]) = 1 then
                  stack[top] := 1
                else
                  stack[top] := 0;
                inc(top);
                dec(tos, 2);
              end;
            lss:
              begin
                dec(top);
                if stack[top - 1] < stack[top] then
                  stack[top - 1] := 1
                else
                  stack[top - 1] := 0;
              end;
            gtr:
              begin
                dec(top);
                if stack[top - 1] > stack[top] then
                  stack[top - 1] := 1
                else
                  stack[top - 1] := 0;
              end;
            leq:
              begin
                dec(top);
                if stack[top - 1] <= stack[top] then
                  stack[top - 1] := 1
                else
                  stack[top - 1] := 0;
              end;
            geq:
              begin
                dec(top);
                if stack[top - 1] >= stack[top] then
                  stack[top - 1] := 1
                else
                  stack[top - 1] := 0;
              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
                  s1 := s1 + s2;
                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
                  inc(stack[m])
                else
                  dec(stack[m]);
                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
    Writeln(inttostr(i) + ' : ' + code[i].toString);
end;

procedure TCellV.printExe;
begin
  if o1 = 0 then
    Exit
  else if o1 = -1 then
  begin
    Writeln;
    Exit;
  end
  else if o1 <> opr then
    Write(codeName(o1) + ' : ');
  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
          Writeln('Istack=' + inttostr(top - 1) + ' : ' +
            inttostr(stack[top - 1]))
        else if o2 < prt then
          Writeln(inttostr(stack[top]))
        else
          Writeln(sstack[tos]);
      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
    code[i].Free;
  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.