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
  begin
        error('�u���b�N���[��������');
  end 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
    begin
        i:=1;
    end else
    begin
        i:=index[level-1]+1;
    end;
    for j:=i to tIndex do
    begin
        Writeln(nameTable[j].toString);
    end;
    for j:=tfIndex to fIndex do
    begin
      if fIndex = 0 then
      begin
                break;
      end;
        Writeln(funcTable[j].toString);
    end;
        Writeln;
  end;
  if level = 0 then
  begin
        dec(level);
  end else
  begin
        dec(level);
    for i:=index[level]+1 to tIndex do
    begin
        nameTable[i].Free;
    end;
        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
  begin
        result:=makeToken;
  end;
end;

function TCellG.checkIn(const n: string): Boolean;
var
  i, j: integer;
begin
  if Length(n) = 0 then
  begin
        result:=true;
  end 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
  begin
        Exit;
  end;
  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
      begin
                errorLine:=errorLine+key[lastT.kind];
      end else
        if k = CellG.Num then
      begin
                errorLine:=errorLine+IntToStr(lastT.value);
      end else
        if k = CellG.Id then
      begin
                errorLine:=errorLine+lastT.id;
      end;
    end;
        cc:=cClass(c);
    while (cc = space)or(cc = cr1)or(cc = tab) do
    begin
      if (cc = space)or(cc = tab) then
      begin
                errorLine:=errorLine+c;
      end;
      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
        begin
                id:=id+c;
        end;
                c:=nextChar;
                cc:=cClass(c);
      end;
      if Length(id) >= MaxName then
      begin
                error('���O������������');
      end;
      for i:=0 to _end_KeyWd do
      begin
        if CompareText(id,key[i]) = 0 then
        begin
                temp.kind:=i;
                temp.id:=id;
                lastT.Free;
                lastT:=temp;
                result:=temp;
                Exit;
        end;
      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
      begin
                temp.kind:=_Equal;
      end;
        break;
    end;
    _Ex:
    begin
        c:=nextChar;
      if c = '=' then
      begin
                temp.kind:=_NotEq;
                c:=nextChar;
      end else
      begin
                temp.kind:=_Ex;
      end;
        break;
    end;
    _Lss:
    begin
        c:=nextChar;
      if c = '=' then
      begin
                temp.kind:=_LssEq;
                c:=nextChar;
      end else
      begin
                temp.kind:=_Lss;
      end;
        break;
    end;
    _Gtr:
    begin
        c:=nextChar;
      if c = '=' then
      begin
                temp.kind:=_GtrEq;
                c:=nextChar;
      end else
      begin
                temp.kind:=_Gtr;
      end;
        break;
    end;
    _Plus:
    begin
        c:=nextChar;
      if c = '+' then
      begin
                temp.kind:=_Plus2;
                c:=nextChar;
      end else
      begin
                temp.kind:=_Plus;
      end;
        break;
    end;
    _Minus:
    begin
        c:=nextChar;
      if c = '-' then
      begin
                temp.kind:=_Minus2;
                c:=nextChar;
      end else
      begin
                temp.kind:=_Minus;
      end;
        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
        begin
                mojiretu:=mojiretu+c;
        end;
                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
  begin
    if funcTable[i+j].name = id then
    begin
        result:=i+j+tIndex;
    end;
  end;
end;

function TCellG.searchT(const id: string): integer;
var
  i: integer;
begin
        result:=0;
        nameTable[0].name:=id;
  for i:=tIndex downto 0 do
  begin
    if id = nameTable[i].name then
    begin
        result:=i;
        break;
    end;
  end;
  if result = 0 then
  begin
        result:=searchF(id,mIndex);
  end;
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
  begin
        error('����������������');
  end;
end;

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

procedure TCellG.setTable(t: TTable);
begin
  if tIndex < MaxTable then
  begin
        inc(tIndex);
        nameTable[tIndex]:=t;
  end else
  begin
        error('����������������');
  end;
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
  begin
        result:=funcTable[n-tIndex].Raddr;
  end else
  begin
        result:=nameTable[n].Raddr;
  end;
end;

function TCellG.tKind(const n: integer): integer;
begin
  if n = 0 then
  begin
        result:=0;
  end else
        if n > tIndex then
  begin
        result:=funcTable[n-tIndex].kind;
  end else
  begin
        result:=nameTable[n].kind;
  end;
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
    begin
        big:=m-1;
    end else
        if c > fClass[m].big then
    begin
        small:=m+1;
    end 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
  begin
        Exit;
  end;
        s.kind:=k;
  if x = true then
  begin
        i:=level-1;
  end else
  begin
        i:=level;
  end;
  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
  begin
    if m = moduleTable[i].name then
    begin
        result:=i;
    end;
  end;
  if result >= 0 then
  begin
        result:=searchF(id,result);
  end;
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
  begin
        error('�������������`������������');
  end;
end;

procedure TCellG.shokika;
var
  i: integer;
begin
  for i:=0 to tIndex do
  begin
        nameTable[i].Free;
  end;
  for i:=0 to fIndex do
  begin
        funcTable[i].Free;
  end;
  for i:=0 to kIndex do
  begin
        kariTable[i].Free;
  end;
  for i:=0 to mIndex do
  begin
        moduleTable[i].Free;
  end;
        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
    begin
      if kariTable[i].sahen <> 0 then
      begin
                error('�����o�������������������������������B');
      end;
    end 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
    begin
      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;
    end;
    if (funcTable[tfIndex] as TTableFunc).parIs <> kariTable[i].pI then
    begin
        error('�����o����������(I)�����������������B');
    end;
    if (funcTable[tfIndex] as TTableFunc).parSs <> kariTable[i].pS then
    begin
        error('�����o����������(S)�����������������B');
    end;
        _cellV.backCal(kariTable[i].cI,level-1,funcTable[tfIndex].Raddr.addr);
        kariTable[i].tf:=true;
        inc(kan);
  end;
begin
  if kIndex = -1 then
  begin
        Exit;
  end;
        s:=moduleTable[mIndex].name;
  for i:=kIndex downto 0 do
  begin
    if kariTable[i].tf = false then
    begin

      if (id = kariTable[i].name)and(s = kariTable[i].md) then
      begin
                main;
      end;

    end;
  end;
end;

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

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

procedure TCellG.setScI(c: integer);
begin
  if kIndex > -1 then
  begin
        kariTable[kIndex].scI:=c;
  end;
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.