view/trunk/CellG.pas

unit CellG;

interface

uses
  SysUtils;

const
  _aI = 1;
  _aS = 2;
  _Read = 3;
  _Print = 4;
  _Println = 5;
  _If = 6;
  _Else = 7;
  _For = 8;
  _While = 9;
  _Do = 10;
  _I = 11;
  _S = 12;
  _V = 13;
  _Return = 14;
  _Break = 15;
  _ReadS = 16;
  _end_KeyWd = 17;

  _Plus = 18;
  _Plus2 = 19;
  _Minus = 20;
  _Minus2 = 21;
  _Mult = 22;
  _Div = 23;
  _Equal = 24;
  _Comma = 25;
  _Semicolon = 26;
  _Lparen = 27;
  _Rparen = 28;
  _Lbrace = 29;
  _Rbrace = 30;
  _Lbracket = 31;
  _Rbracket = 32;
  _Equal2 = 33;
  _Lss = 34;
  _Gtr = 35;
  _LssEq = 36;
  _GtrEq = 37;
  _NotEq = 38;
  _Ex = 39;
  _DQ = 40;
  _Period = 41;
  _end_Sym = 42;

  intID = 41;
  arrI = 42;
  arrS = 43;
  funID = 44;
  parI = 45;
  strID = 46;
  parS = 47;

  Id = 51;
  Num = 52;
  Moji = 53;
  nul = 54;
  end_Token = 55;

  others = 61;
  digit = 62;
  letter = 63;
  space = 64;
  tab = 65;
  cr1 = 66;
  dollar = 67;
  at = 68;

  MaxName = 20;
  MaxTable = 200;
  MaxModule = 50;
  MaxLevel = 20;
  firstAddr = 3;

type
  TcClass = record
    small: Char;
    big: Char;
    result: integer;
  end;

  TToken = class
  public
    kind: integer;
    Id: string;
    value: integer;
  end;

  TRaddr = record
    level: integer;
    addr: integer;
  end;

  TModule = class
  public
    name: string;
    index: integer;
    number: integer;
    constructor Create(n: string; i, s: integer); overload;
    constructor Create(n: string); overload;
  end;

  TTable = class
  public
    name: string;
    kind: integer;
    Raddr: TRaddr;
    constructor Create(const Id: string; const k, l, a: integer); overload;
    constructor Create(const Id: string); overload;
    function toString: string; virtual;
  end;

  TTableArray = class(TTable)
  public
    jigen: integer;
    gyou: integer;
    retu: integer;
    constructor Create(const Id: string; const k, l, a, j, g, r: integer);
    function toString: string; override;
  end;

  TTableFunc = class(TTable)
  public
    modori: integer;
    parIs: integer;
    parSs: integer;
    constructor Create(const Id: string; const k, l, a, m, pi, ps: integer);
    function toString: string; override;
  end;

  TKari = class
  public
    name: string;
    md: string;
    sahen: integer;
    tI: integer;
    lcI: integer;
    scI: integer;
    pi: integer;
    ps: integer;
    cI: integer;
    tf: Boolean;
    constructor Create(n, m: string; s, t, lc, sc, pi, ps, c: integer;
      f: Boolean);
  end;

  TCellG = class
  private
    nameTable: array [0 .. MaxTable] of TTable;
    funcTable: array [0 .. MaxTable div 2] of TTable;
    moduleTable: array [0 .. MaxModule] of TModule;
    kariTable: array [0 .. MaxTable div 4] of TKari;
    tIndex: integer;
    fIndex: integer;
    tfIndex: integer;
    mIndex: integer;
    kIndex: integer;
    kan: integer;
    localAddr: integer;
    slocalAddr: integer;
    level: integer;
    index: array [0 .. MaxLevel] of integer;
    addr: array [0 .. MaxLevel] of integer;
    saddr: array [0 .. MaxLevel] of integer;
    BufferedReader: TextFile;
    c: Char;
    line: string;
    lineIndex: integer;
    errorLine: string;
    cr: integer;
    lastT: TToken;
    mojiretu: string;
    key: array [0 .. _end_Sym] of string;
  public
    pTable: Boolean;
    e: integer;
    exe: integer;
    constructor Create(p: Boolean);
    destructor Destroy; override;
    function open(const f: TFileName; cellV: TObject): Boolean;
    procedure closeFile;
    procedure blockBegin;
    procedure blockEnd;
    procedure setTable(t: TTable);
    procedure setModule(Id: string);
    procedure setKariTable(Id, m: string; s, tI, lc, pi, ps, c: integer);
    procedure setScI(c: integer);
    function moduleName: string;
    function tableInt(const Id: string): integer;
    procedure initKey;
    procedure setFunc(t: TTable);
    function tablePstr(Id: string): integer;
    function tableString(Id: string): integer;
    function tableA1int(const Id: string; const n: integer): integer;
    function tableA2int(const Id: string; const x, v: integer): integer;
    function tableA1str(Id: string; n: integer): integer;
    function tableA2str(Id: string; x, v: integer): integer;
    function tableFunc(const Id: string; const c, mm: integer): integer;
    function tablePint(const Id: string): integer;
    procedure endPar;
    procedure changeT(t, k: integer; x: Boolean);
    function searchT(const Id: string): integer;
    function searchF(const Id: string; m: integer): integer;
    function searchFModule(m, Id: string): integer;
    procedure checkKari(Id: string);
    procedure checkKan;
    function tAddr(const n: integer): TRaddr;
    function bLevel: integer;
    function funcParIs: integer;
    function funcParSs: integer;
    function fModori(n: integer): integer;
    function funcModori: integer;
    function pKazuI(const n: integer): integer;
    function pKazuS(n: integer): integer;
    function tKind(const n: integer): integer;
    function hairetu(const n: integer): TRaddr;
    function numAddr: integer;
    function snumAddr: integer;
    function nextTIndex: integer;
    function checkGet(t: TToken; const k: integer): TToken;
    function jigen(const i: integer): integer;
    function checkIn(const n: string): Boolean;
    procedure error(const er: string);
    procedure shokika;
    function nextChar: Char;
    function makeToken: TToken;
    function cClass(c: Char): integer;
  end;

function hyouji(const k: integer): string;

const
  fClass: array [0 .. 25] of TcClass = ((small: #$09; big: #$09; result: tab),
    (small: #13; big: #13; result: cr1), (small: ' '; big: ' '; result: space),
    (small: '!'; big: '!'; result: _Ex), (small: '"'; big: '"'; result: _DQ),
    (small: '$'; big: '$'; result: dollar), (small: '('; big: '(';
    result: _Lparen), (small: ')'; big: ')'; result: _Rparen), (small: '*';
    big: '*'; result: _Mult), (small: '+'; big: '+'; result: _Plus),
    (small: ','; big: ','; result: _Comma), (small: '-'; big: '-';
    result: _Minus), (small: '.'; big: '.'; result: _Period), (small: '/';
    big: '/'; result: _Div), (small: '0'; big: '9'; result: digit), (small: ';';
    big: ';'; result: _Semicolon), (small: '<'; big: '<'; result: _Lss),
    (small: '='; big: '='; result: _Equal), (small: '>'; big: '>';
    result: _Gtr), (small: '@'; big: '@'; result: at), (small: 'A'; big: 'Z';
    result: letter), (small: '['; big: '['; result: _Lbracket), (small: ']';
    big: ']'; result: _Rbracket), (small: 'a'; big: 'z'; result: letter),
    (small: '{'; big: '{'; result: _Lbrace), (small: '}'; big: '}';
    result: _Rbrace));

implementation

uses cellV;

const
  MaxMoji = 200;

var
  _cellV: TCellV;

function hyouji(const k: integer): string;
begin
  case k of
    intID:
      result := 'intID';
    strID:
      result := 'strID';
    arrI:
      result := 'arrI';
    funID:
      result := 'funID';
    parI:
      result := 'parI';
    parS:
      result := 'parS';
    _I:
      result := 'I';
    _S:
      result := 'S';
    _V:
      result := 'V';
  else
    result := IntToStr(k);
  end;
end;

{ TTable }

constructor TTable.Create(const Id: string; const k, l, a: integer);
begin
  inherited Create;
  name := Id;
  kind := k;
  Raddr.level := l;
  Raddr.addr := a;
end;

constructor TTable.Create(const Id: string);
begin
  inherited Create;
  name := Id;
end;

function TTable.toString: string;
begin
  result := name + ' : ' + hyouji(kind) + ' : ' + IntToStr(Raddr.level) +
    IntToStr(Raddr.addr);
end;

{ TTableArray }

constructor TTableArray.Create(const Id: string;
  const k, l, a, j, g, r: integer);
begin
  inherited Create(Id, k, l, a);
  jigen := j;
  gyou := g;
  retu := r;
end;

function TTableArray.toString: string;
begin
  result := inherited toString + ' : ' + IntToStr(jigen) + '����: ' +
    IntToStr(gyou) + IntToStr(retu) + '��';
end;

{ TCellG }

function TCellG.bLevel: integer;
begin
  result := level;
end;

procedure TCellG.blockBegin;
begin
  if level = -1 then
  begin
    localAddr := firstAddr;
    slocalAddr := 0;
    tIndex := 0;
    inc(level);
  end
  else if level = MaxLevel - 1 then
    error('�u���b�N���[��������')
  else
  begin
    index[level] := tIndex;
    addr[level] := localAddr;
    saddr[level] := slocalAddr;
    localAddr := firstAddr;
    slocalAddr := 0;
    inc(level);
  end;
end;

procedure TCellG.blockEnd;
var
  i, j: integer;
begin
  if pTable = true then
  begin
    Writeln('--level : ' + IntToStr(level) + '--');
    if level = 0 then
      i := 1
    else
      i := index[level - 1] + 1;
    for j := i to tIndex do
      Writeln(nameTable[j].toString);
    for j := tfIndex to fIndex do
    begin
      if fIndex = 0 then
        break;
      Writeln(funcTable[j].toString);
    end;
    Writeln;
  end;
  if level = 0 then
    dec(level)
  else
  begin
    dec(level);
    for i := index[level] + 1 to tIndex do
      nameTable[i].Free;
    tIndex := index[level];
    localAddr := addr[level];
    slocalAddr := saddr[level];
  end;
end;

function TCellG.checkGet(t: TToken; const k: integer): TToken;
begin
  if t.kind <> k then
  begin
    error('��������������-' + key[k]);
    result := t;
  end
  else
    result := makeToken;
end;

function TCellG.checkIn(const n: string): Boolean;
var
  i, j: integer;
begin
  if Length(n) = 0 then
    result := true
  else
  begin
    result := false;
    for i := 1 to Length(n) do
    begin
      j := cClass(n[i]);
      if j <> digit then
      begin
        result := true;
        break;
      end;
    end;
  end;
end;

procedure TCellG.closeFile;
begin
  try
    System.closeFile(BufferedReader);
  except
    on EInOutError do
      Writeln('�t�@�C������������������');
  end;
end;

constructor TCellG.Create(p: Boolean);
begin
  inherited Create;
  pTable := p;
  lastT := TToken.Create;
  initKey;
  shokika;
end;

destructor TCellG.Destroy;
begin
  lastT.Free;
  nameTable[0].Free;
  moduleTable[0].Free;
  inherited;
end;

procedure TCellG.endPar;
var
  i, pi, ps: integer;
begin
  with funcTable[tfIndex] as TTableFunc do
  begin
    pi := parIs;
    ps := parSs;
  end;
  if (pi = 0) and (ps = 0) then
    Exit;
  for i := tfIndex + 1 to tfIndex + pi + ps do
  begin
    if funcTable[i].kind = parI then
    begin
      funcTable[i].Raddr.addr := -pi;
      dec(pi);
    end
    else
    begin
      funcTable[i].Raddr.addr := -ps;
      dec(ps);
    end;
  end;
end;

procedure TCellG.error(const er: string);
begin
  inc(e);
  Writeln(IntToStr(cr) + ' : ' + errorLine + ' : ' + er + '�B');
  errorLine := '';
end;

function TCellG.fModori(n: integer): integer;
begin
  result := (funcTable[n - tIndex] as TTableFunc).modori;
end;

function TCellG.funcParIs: integer;
begin
  result := (funcTable[tfIndex] as TTableFunc).parIs;
end;

function TCellG.hairetu(const n: integer): TRaddr;
begin
  with nameTable[n] as TTableArray do
  begin
    result.level := gyou;
    result.addr := retu;
  end;
end;

procedure TCellG.initKey;
begin
  key[_aI] := 'aI';
  key[_Print] := 'print';
  key[_Println] := 'println';
  key[_Read] := 'read';
  key[_ReadS] := 'reads';
  key[_If] := 'if';
  key[_Else] := 'else';
  key[_For] := 'for';
  key[_While] := 'while';
  key[_Do] := 'do';
  key[_I] := 'i';
  key[_S] := 's';
  key[_V] := 'v';
  key[_Return] := 'return';
  key[_Break] := 'break';
  key[_end_KeyWd] := 'dummy1';
  key[_Plus] := '+';
  key[_Minus] := '-';
  key[_Mult] := '*';
  key[_Equal] := '=';
  key[_Comma] := ',';
  key[_Semicolon] := ':';
  key[_Lparen] := '(';
  key[_Rparen] := ')';
  key[_Lbrace] := '{';
  key[_Rbrace] := '}';
  key[_Lbracket] := '[';
  key[_Rbracket] := ']';
  key[_Lss] := '<';
  key[_Gtr] := '>';
  key[_LssEq] := '<=';
  key[_GtrEq] := '>=';
  key[_NotEq] := '!=';
  key[_Ex] := '!';
  key[_end_Sym] := 'dummy2';
end;

function TCellG.jigen(const i: integer): integer;
begin
  result := TTableArray(nameTable[i]).jigen;
end;

function TCellG.makeToken: TToken;
var
  i: integer;
  cc, k: integer;
  Num: integer;
  temp: TToken;
  Id: string;
begin
  temp := TToken.Create;
  while true do
  begin
    k := lastT.kind;
    if k <> nul then
    begin
      if k < _end_Sym then
        errorLine := errorLine + key[lastT.kind]
      else if k = CellG.Num then
        errorLine := errorLine + IntToStr(lastT.value)
      else if k = CellG.Id then
        errorLine := errorLine + lastT.Id;
    end;
    cc := cClass(c);
    while (cc = space) or (cc = cr1) or (cc = tab) do
    begin
      if (cc = space) or (cc = tab) then
        errorLine := errorLine + c;
      if cc = cr1 then
      begin
        inc(cr);
        errorLine := '';
      end;
      c := nextChar;
      cc := cClass(c);
    end;
    case cc of
      digit:
        begin
          Num := 0;
          while cc = digit do
          begin
            Num := 10 * Num + StrToInt(c);
            c := nextChar;
            cc := cClass(c);
          end;
          temp.kind := CellG.Num;
          temp.value := Num;
          break;
        end;
      letter, others:
        begin
          Id := '';
          while (cc = letter) or (cc = digit) or (cc = others) do
          begin
            if Length(Id) < MaxName then
              Id := Id + c;
            c := nextChar;
            cc := cClass(c);
          end;
          if Length(Id) >= MaxName then
            error('���O������������');
          for i := 0 to _end_KeyWd do
            if CompareText(Id, key[i]) = 0 then
            begin
              temp.kind := i;
              temp.Id := Id;
              lastT.Free;
              lastT := temp;
              result := temp;
              Exit;
            end;
          temp.kind := CellG.Id;
          temp.Id := Id;
          break;
        end;
      _Equal:
        begin
          c := nextChar;
          if c = '=' then
          begin
            temp.kind := _Equal2;
            c := nextChar;
          end
          else
            temp.kind := _Equal;
          break;
        end;
      _Ex:
        begin
          c := nextChar;
          if c = '=' then
          begin
            temp.kind := _NotEq;
            c := nextChar;
          end
          else
            temp.kind := _Ex;
          break;
        end;
      _Lss:
        begin
          c := nextChar;
          if c = '=' then
          begin
            temp.kind := _LssEq;
            c := nextChar;
          end
          else
            temp.kind := _Lss;
          break;
        end;
      _Gtr:
        begin
          c := nextChar;
          if c = '=' then
          begin
            temp.kind := _GtrEq;
            c := nextChar;
          end
          else
            temp.kind := _Gtr;
          break;
        end;
      _Plus:
        begin
          c := nextChar;
          if c = '+' then
          begin
            temp.kind := _Plus2;
            c := nextChar;
          end
          else
            temp.kind := _Plus;
          break;
        end;
      _Minus:
        begin
          c := nextChar;
          if c = '-' then
          begin
            temp.kind := _Minus2;
            c := nextChar;
          end
          else
            temp.kind := _Minus;
          break;
        end;
      at:
        begin
          c := nextChar;
          cc := cClass(c);
          while cc <> at do
          begin
            errorLine := errorLine + c;
            c := nextChar;
            cc := cClass(c);
          end;
          c := nextChar;
          continue;
        end;
      _DQ:
        begin
          i := 1;
          mojiretu := '';
          repeat
            if i < MaxMoji then
              mojiretu := mojiretu + c;
            inc(i);
            c := nextChar;
            cc := cClass(c);
          until (cc = _DQ) or (cc = _Rbrace) or (cc = _Semicolon);
          if (cc = _Rbrace) or (cc = _Semicolon) then
          begin
            error('"�������������B');
            temp.kind := cc;
            lastT := temp;
            result := temp;
            Exit;
          end;
          if i >= MaxMoji then
          begin
            error('����������������');
            i := MaxName - 1;
          end;
          mojiretu := mojiretu + '"';
          temp.kind := Moji;
          temp.Id := Copy(mojiretu, 2, i - 2);
          c := nextChar;
          break;
        end;
      dollar:
        begin
          checkKan;
          temp.kind := dollar;
          break;
        end;
    else
      temp.kind := cc;
      c := nextChar;
      break;
    end;
  end;
  lastT.Free;
  lastT := temp;
  result := temp;
end;

function TCellG.nextChar: Char;
begin
  if lineIndex > Length(line) then
  begin
    if Eof(BufferedReader) = true then
    begin
      Writeln(IntToStr(cr) + ':�t�@�C���I���A$�������������B' + IntToStr(e),
        '�G���[����:' + IntToStr(e + 1));
      System.closeFile(BufferedReader);
      raise EInOutError.Create('error');
    end;
    lineIndex := 1;
    try
      Readln(BufferedReader, line);
    except
      Writeln(IntToStr(cr) + '�����s�����������������B' + ' : ' + IntToStr(e),
        '�G���[����:' + IntToStr(e + 1));
      raise;
    end;
    result := #13;
  end
  else
  begin
    result := line[lineIndex];
    inc(lineIndex);
  end;
end;

function TCellG.numAddr: integer;
begin
  result := localAddr;
end;

function TCellG.snumAddr: integer;
begin
  result := slocalAddr;
end;

function TCellG.open(const f: TFileName; cellV: TObject): Boolean;
begin
  _cellV := cellV as TCellV;
  if FileExists(f) = false then
  begin
    result := false;
    Exit;
  end;
  try
    AssignFile(BufferedReader, f);
    Reset(BufferedReader);
    Readln(BufferedReader, line);
    lineIndex := 1;
    c := nextChar;
    lastT.kind := nul;
    result := true;
  except
    on EInOutError do
    begin
      Writeln('�t�@�C�����J��������');
      result := false;
    end;
  end;
end;

function TCellG.pKazuI(const n: integer): integer;
begin
  result := (funcTable[n - tIndex] as TTableFunc).parIs;
end;

function TCellG.searchF(const Id: string; m: integer): integer;
var
  i, j: integer;
begin
  i := moduleTable[m].index;
  result := 0;
  for j := 0 to moduleTable[m].number - 1 do
    if funcTable[i + j].name = Id then
      result := i + j + tIndex;
end;

function TCellG.searchT(const Id: string): integer;
var
  i: integer;
begin
  result := 0;
  nameTable[0].name := Id;
  for i := tIndex downto 0 do
    if Id = nameTable[i].name then
    begin
      result := i;
      break;
    end;
  if result = 0 then
    result := searchF(Id, mIndex);
end;

procedure TCellG.setFunc(t: TTable);
begin
  if fIndex < (MaxTable div 2) then
  begin
    inc(fIndex);
    funcTable[fIndex] := t;
    inc(moduleTable[mIndex].number);
  end
  else
    error('����������������');
end;

procedure TCellG.setModule(Id: string);
begin
  inc(mIndex);
  if mIndex < MaxModule then
    moduleTable[mIndex] := TModule.Create(Id, fIndex + 1, 0)
  else
    error('���W���[��������������');
end;

procedure TCellG.setTable(t: TTable);
begin
  if tIndex < MaxTable then
  begin
    inc(tIndex);
    nameTable[tIndex] := t;
  end
  else
    error('����������������');
end;

function TCellG.tableA1int(const Id: string; const n: integer): integer;
begin
  setTable(TTableArray.Create(Id, arrI, level, localAddr, 1, 0, n));
  inc(localAddr, n);
  result := tIndex;
end;

function TCellG.tableA2int(const Id: string; const x, v: integer): integer;
begin
  setTable(TTableArray.Create(Id, arrI, level, localAddr, 2, x, v));
  inc(localAddr, x * v);
  result := tIndex;
end;

function TCellG.tableFunc(const Id: string; const c, mm: integer): integer;
begin
  setFunc(TTableFunc.Create(Id, funID, level, c, mm, 0, 0));
  tfIndex := fIndex;
  result := fIndex + tIndex;
end;

function TCellG.tableInt(const Id: string): integer;
begin
  setTable(TTable.Create(Id, intID, level, localAddr));
  inc(localAddr);
  result := tIndex;
end;

function TCellG.tableString(Id: string): integer;
begin
  setTable(TTable.Create(Id, strID, level, slocalAddr));
  inc(slocalAddr);
  result := tIndex;
end;

function TCellG.tablePint(const Id: string): integer;
begin
  setFunc(TTable.Create(Id, parI, level, 0));
  inc((funcTable[tfIndex] as TTableFunc).parIs);
  result := fIndex + tIndex;
end;

function TCellG.tablePstr(Id: string): integer;
begin
  setFunc(TTable.Create(Id, parS, level, 0));
  inc((funcTable[tfIndex] as TTableFunc).parSs);
  result := fIndex + tIndex;
end;

function TCellG.tAddr(const n: integer): TRaddr;
begin
  if n > tIndex then
    result := funcTable[n - tIndex].Raddr
  else
    result := nameTable[n].Raddr;
end;

function TCellG.tKind(const n: integer): integer;
begin
  if n = 0 then
    result := 0
  else if n > tIndex then
    result := funcTable[n - tIndex].kind
  else
    result := nameTable[n].kind;
end;

function TCellG.cClass(c: Char): integer;
var
  small, big, m: integer;
begin
  result := others;
  small := 0;
  big := High(fClass);
  while small <= big do
  begin
    m := (small + big) div 2;
    if c < fClass[m].small then
      big := m - 1
    else if c > fClass[m].big then
      small := m + 1
    else
    begin
      result := fClass[m].result;
      break;
    end;
  end;
end;

procedure TCellG.changeT(t, k: integer; x: Boolean);
var
  i: integer;
  s: TTable;
begin
  s := nameTable[t];
  if s.kind = k then
    Exit;
  s.kind := k;
  if x = true then
    i := level - 1
  else
    i := level;
  if k = intID then
  begin
    if i = s.Raddr.level then
    begin
      s.Raddr.addr := localAddr;
      inc(localAddr);
      dec(slocalAddr);
    end
    else
    begin
      s.Raddr.level := addr[s.Raddr.level];
      inc(addr[s.Raddr.level]);
      dec(saddr[s.Raddr.level]);
    end;
  end
  else if k = strID then
  begin
    if i = s.Raddr.level then
    begin
      s.Raddr.addr := slocalAddr;
      inc(slocalAddr);
      dec(localAddr);
    end
    else
    begin
      s.Raddr.level := saddr[s.Raddr.level];
      inc(saddr[s.Raddr.level]);
      dec(addr[s.Raddr.level]);
    end;
  end;
end;

function TCellG.moduleName: string;
begin
  result := moduleTable[mIndex].name;
end;

function TCellG.nextTIndex: integer;
begin
  result := tIndex + 1;
end;

function TCellG.searchFModule(m, Id: string): integer;
var
  i: integer;
begin
  result := -1;
  moduleTable[0].name := m;
  for i := mIndex downto 0 do
    if m = moduleTable[i].name then
      result := i;
  if result >= 0 then
    result := searchF(Id, result);
end;

function TCellG.pKazuS(n: integer): integer;
begin
  result := (funcTable[n - tIndex] as TTableFunc).parSs;
end;

function TCellG.funcModori: integer;
begin
  result := (funcTable[tfIndex] as TTableFunc).modori;
end;

procedure TCellG.setKariTable(Id, m: string; s, tI, lc, pi, ps, c: integer);
begin
  if kIndex < (MaxTable div 4) then
  begin
    inc(kIndex);
    kariTable[kIndex] := TKari.Create(Id, m, s, tI, lc, 0, pi, ps, c, false);
  end
  else
    error('�������������`������������')
end;

procedure TCellG.shokika;
var
  i: integer;
begin
  for i := 0 to tIndex do
    nameTable[i].Free;
  for i := 0 to fIndex do
    funcTable[i].Free;
  for i := 0 to kIndex do
    kariTable[i].Free;
  for i := 0 to mIndex do
    moduleTable[i].Free;
  kan := -1;
  tIndex := 0;
  tfIndex := 0;

  localAddr := 0;
  slocalAddr := 0;
  e := 0;
  errorLine := '';

  level := -1;
  kIndex := -1;
  fIndex := 0;
  mIndex := -1;
  cr := 1;
  nameTable[0] := TTable.Create;
  moduleTable[0] := TModule.Create;
end;

procedure TCellG.checkKari(Id: string);
var
  i: integer;
  s: string;
  procedure main;
  var
    j: integer;
  begin
    j := (funcTable[tfIndex] as TTableFunc).modori;
    if j = _V then
      if kariTable[i].sahen <> 0 then
        error('�����o�������������������������������B')
      else if j = _I then
      begin
        case kariTable[i].sahen of
          strID:
            begin
              changeT(kariTable[i].tI, intID, true);
              _cellV.backPatchL(kariTable[i].lcI, kariTable[i].tI, 0);
              _cellV.changeS(kariTable[i].scI, 0);
            end;
          parS:
            error('�����o�������^�����v���������B');
        end;
      end
      else if j = _S then
        case kariTable[i].sahen of
          intID:
            begin
              changeT(kariTable[i].tI, strID, true);
              _cellV.backPatchL(kariTable[i].lcI, kariTable[i].tI, 1);
              _cellV.changeS(kariTable[i].scI, 1);
            end;
          arrI, parI:
            error('�����o�������^�����v���������B');
        end;
    if (funcTable[tfIndex] as TTableFunc).parIs <> kariTable[i].pi then
      error('�����o����������(I)�����������������B');
    if (funcTable[tfIndex] as TTableFunc).parSs <> kariTable[i].ps then
      error('�����o����������(S)�����������������B');
    _cellV.backCal(kariTable[i].cI, level - 1, funcTable[tfIndex].Raddr.addr);
    kariTable[i].tf := true;
    inc(kan);
  end;

begin
  if kIndex = -1 then
    Exit;
  s := moduleTable[mIndex].name;
  for i := kIndex downto 0 do
    if kariTable[i].tf = false then
      if (Id = kariTable[i].name) and (s = kariTable[i].md) then
        main;
end;

function TCellG.funcParSs: integer;
begin
  result := (funcTable[tfIndex] as TTableFunc).parSs;
end;

procedure TCellG.checkKan;
begin
  if kan < kIndex then
    error('���`��������������������������');
end;

procedure TCellG.setScI(c: integer);
begin
  if kIndex > -1 then
    kariTable[kIndex].scI := c;
end;

function TCellG.tableA1str(Id: string; n: integer): integer;
begin
  setTable(TTableArray.Create(Id, arrS, level, slocalAddr, 1, 0, n));
  inc(slocalAddr, n);
  result := tIndex;
end;

function TCellG.tableA2str(Id: string; x, v: integer): integer;
begin
  setTable(TTableArray.Create(Id, arrS, level, slocalAddr, 2, x, v));
  inc(slocalAddr, x * v);
  result := tIndex;
end;

{ TTableFunc }

constructor TTableFunc.Create(const Id: string;
  const k, l, a, m, pi, ps: integer);
begin
  inherited Create(Id, k, l, a);
  modori := m;
  parIs := pi;
  parIs := ps;
end;

function TTableFunc.toString: string;
begin
  result := (inherited toString) + ' : ' + hyouji(modori) + ' : ' +
    IntToStr(parIs) + 'pI' + ' : ' + IntToStr(parSs) + 'pS';
end;

{ TModule }

constructor TModule.Create(n: string; i, s: integer);
begin
  inherited Create;
  name := n;
  index := i;
  number := s;
end;

constructor TModule.Create(n: string);
begin
  inherited Create;
  name := n;
end;

{ TKari }

constructor TKari.Create(n, m: string; s, t, lc, sc, pi, ps, c: integer;
  f: Boolean);
begin
  inherited Create;
  name := n;
  md := m;
  sahen := s;
  tI := t;
  lcI := lc;
  scI := sc;
  self.pi := pi;
  self.ps := ps;
  cI := c;
  tf := f;
end;

end.