Develop and Download Open Source Software

cellcompilerd

Browse Subversion Repository

/[cellcompilerd]/trunk/CellG.pas

Diff of /trunk/CellG.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3 by yamat0jp, Mon Feb 23 07:50:11 2015 UTC revision 4 by yamat0jp, Thu Apr 6 08:50:57 2017 UTC
# Line 89  type Line 89  type
89    TToken = class    TToken = class
90    public    public
91      kind: integer;      kind: integer;
92      id: string;      Id: string;
93      value: integer;      value: integer;
94    end;    end;
95    
# Line 112  type Line 112  type
112      name: string;      name: string;
113      kind: integer;      kind: integer;
114      Raddr: TRaddr;      Raddr: TRaddr;
115      constructor Create(const id: string; const k, l, a: integer); overload;      constructor Create(const Id: string; const k, l, a: integer); overload;
116      constructor Create(const id: string); overload;      constructor Create(const Id: string); overload;
117      function toString: string; virtual;      function toString: string; virtual;
118    end;    end;
119    
# Line 122  type Line 122  type
122      jigen: integer;      jigen: integer;
123      gyou: integer;      gyou: integer;
124      retu: integer;      retu: integer;
125      constructor Create(const id: string; const k, l, a, j, g, r: integer);      constructor Create(const Id: string; const k, l, a, j, g, r: integer);
126      function toString: string; override;      function toString: string; override;
127    end;    end;
128    
# Line 131  type Line 131  type
131      modori: integer;      modori: integer;
132      parIs: integer;      parIs: integer;
133      parSs: integer;      parSs: integer;
134      constructor Create(const id: string; const k, l, a, m, pi, ps: integer);      constructor Create(const Id: string; const k, l, a, m, pi, ps: integer);
135      function toString: string; override;      function toString: string; override;
136    end;    end;
137    
# Line 143  type Line 143  type
143      tI: integer;      tI: integer;
144      lcI: integer;      lcI: integer;
145      scI: integer;      scI: integer;
146      pI: integer;      pi: integer;
147      pS: integer;      ps: integer;
148      cI: integer;      cI: integer;
149      tf: Boolean;      tf: Boolean;
150      constructor Create(n, m: string; s, t, lc, sc, pi, ps, c: integer; f: Boolean);      constructor Create(n, m: string; s, t, lc, sc, pi, ps, c: integer;
151          f: Boolean);
152    end;    end;
153    
154    TCellG = class    TCellG = class
155    private    private
156      nameTable: array [0..MaxTable] of TTable;      nameTable: array [0 .. MaxTable] of TTable;
157      funcTable: array [0..MaxTable div 2] of TTable;      funcTable: array [0 .. MaxTable div 2] of TTable;
158      moduleTable: array [0..MaxModule] of TModule;      moduleTable: array [0 .. MaxModule] of TModule;
159      kariTable: array [0..MaxTable div 4] of TKari;      kariTable: array [0 .. MaxTable div 4] of TKari;
160      tIndex: integer;      tIndex: integer;
161      fIndex: integer;      fIndex: integer;
162      tfIndex: integer;      tfIndex: integer;
# Line 165  type Line 166  type
166      localAddr: integer;      localAddr: integer;
167      slocalAddr: integer;      slocalAddr: integer;
168      level: integer;      level: integer;
169      index: array [0..MaxLevel] of integer;      index: array [0 .. MaxLevel] of integer;
170      addr: array [0..MaxLevel] of integer;      addr: array [0 .. MaxLevel] of integer;
171      saddr: array [0..MaxLevel] of integer;      saddr: array [0 .. MaxLevel] of integer;
172      BufferedReader: TextFile;      BufferedReader: TextFile;
173      c: Char;      c: Char;
174      line: string;      line: string;
# Line 176  type Line 177  type
177      cr: integer;      cr: integer;
178      lastT: TToken;      lastT: TToken;
179      mojiretu: string;      mojiretu: string;
180      key: array [0.._end_Sym] of string;      key: array [0 .. _end_Sym] of string;
181    public    public
182      pTable: Boolean;      pTable: Boolean;
183      e: integer;      e: integer;
# Line 188  type Line 189  type
189      procedure blockBegin;      procedure blockBegin;
190      procedure blockEnd;      procedure blockEnd;
191      procedure setTable(t: TTable);      procedure setTable(t: TTable);
192      procedure setModule(id: string);      procedure setModule(Id: string);
193      procedure setKariTable(id, m: string; s, ti, lc, pi, ps, c: integer);      procedure setKariTable(Id, m: string; s, tI, lc, pi, ps, c: integer);
194      procedure setScI(c: integer);      procedure setScI(c: integer);
195      function moduleName: string;      function moduleName: string;
196      function tableInt(const id: string): integer;      function tableInt(const Id: string): integer;
197      procedure initKey;      procedure initKey;
198      procedure setFunc(t: TTable);      procedure setFunc(t: TTable);
199      function tablePstr(id: string): integer;      function tablePstr(Id: string): integer;
200      function tableString(id: string): integer;      function tableString(Id: string): integer;
201      function tableA1int(const id: string; const n: integer): integer;      function tableA1int(const Id: string; const n: integer): integer;
202      function tableA2int(const id: string; const x, v: integer): integer;      function tableA2int(const Id: string; const x, v: integer): integer;
203      function tableA1str(id: string; n: integer): integer;      function tableA1str(Id: string; n: integer): integer;
204      function tableA2str(id: string; x, v: integer): integer;      function tableA2str(Id: string; x, v: integer): integer;
205      function tableFunc(const id: string; const c, mm: integer): integer;      function tableFunc(const Id: string; const c, mm: integer): integer;
206      function tablePint(const id: string): integer;      function tablePint(const Id: string): integer;
207      procedure endPar;      procedure endPar;
208      procedure changeT(t, k: integer; x: Boolean);      procedure changeT(t, k: integer; x: Boolean);
209      function searchT(const id: string): integer;      function searchT(const Id: string): integer;
210      function searchF(const id: string; m: integer): integer;      function searchF(const Id: string; m: integer): integer;
211      function searchFModule(m, id: string): integer;      function searchFModule(m, Id: string): integer;
212      procedure checkKari(id: string);      procedure checkKari(Id: string);
213      procedure checkKan;      procedure checkKan;
214      function tAddr(const n: integer): TRaddr;      function tAddr(const n: integer): TRaddr;
215      function bLevel: integer;      function bLevel: integer;
# Line 233  type Line 234  type
234      function cClass(c: Char): integer;      function cClass(c: Char): integer;
235    end;    end;
236    
237    function hyouji(const k: integer): string;  function hyouji(const k: integer): string;
238    
239  const  const
240    fClass: array [0..25] of TcClass = ((small: #$09; big: #$09; result: tab),(small: #13; big: #13; result: cr1),    fClass: array [0 .. 25] of TcClass = ((small: #$09; big: #$09; result: tab),
241      (small: ' '; big: ' '; result: space),(small: '!'; big: '!'; result: _Ex),(small: '"'; big: '"'; result: _DQ),      (small: #13; big: #13; result: cr1), (small: ' '; big: ' '; result: space),
242      (small: '$'; big: '$'; result: dollar),(small: '('; big: '('; result: _Lparen),(small: ')'; big: ')'; result: _Rparen),      (small: '!'; big: '!'; result: _Ex), (small: '"'; big: '"'; result: _DQ),
243      (small: '*'; big: '*'; result: _Mult),(small: '+'; big: '+'; result: _Plus),(small: ','; big: ','; result: _Comma),      (small: '$'; big: '$'; result: dollar), (small: '('; big: '(';
244      (small: '-'; big: '-'; result: _Minus),(small: '.'; big: '.'; result: _Period),(small: '/'; big: '/'; result: _Div),      result: _Lparen), (small: ')'; big: ')'; result: _Rparen), (small: '*';
245      (small: '0'; big: '9'; result: digit),(small: ';'; big: ';'; result: _Semicolon),(small: '<'; big: '<'; result: _Lss),      big: '*'; result: _Mult), (small: '+'; big: '+'; result: _Plus),
246      (small: '='; big: '='; result: _Equal),(small: '>'; big: '>'; result: _Gtr),(small: '@'; big: '@'; result: at),      (small: ','; big: ','; result: _Comma), (small: '-'; big: '-';
247      (small: 'A'; big: 'Z'; result: letter),(small: '['; big: '['; result: _Lbracket),(small: ']'; big: ']'; result: _Rbracket),      result: _Minus), (small: '.'; big: '.'; result: _Period), (small: '/';
248      (small: 'a'; big: 'z'; result: letter),(small: '{'; big: '{'; result: _Lbrace),(small: '}'; big: '}'; result: _Rbrace));      big: '/'; result: _Div), (small: '0'; big: '9'; result: digit), (small: ';';
249        big: ';'; result: _Semicolon), (small: '<'; big: '<'; result: _Lss),
250        (small: '='; big: '='; result: _Equal), (small: '>'; big: '>';
251        result: _Gtr), (small: '@'; big: '@'; result: at), (small: 'A'; big: 'Z';
252        result: letter), (small: '['; big: '['; result: _Lbracket), (small: ']';
253        big: ']'; result: _Rbracket), (small: 'a'; big: 'z'; result: letter),
254        (small: '{'; big: '{'; result: _Lbrace), (small: '}'; big: '}';
255        result: _Rbrace));
256    
257  implementation  implementation
258    
259  uses CellV;  uses cellV;
260    
261  const  const
262    MaxMoji = 200;    MaxMoji = 200;
263    
264  var  var
265    _cellV: TCellV;    _cellV: TCellV;
266      
267  function hyouji(const k: integer): string;  function hyouji(const k: integer): string;
268  begin  begin
269    case k of    case k of
270    intID:      intID:
271          result:='intID';        result := 'intID';
272    strID:      strID:
273          result:='strID';        result := 'strID';
274    arrI:      arrI:
275          result:='arrI';        result := 'arrI';
276    funID:      funID:
277          result:='funID';        result := 'funID';
278    parI:      parI:
279          result:='parI';        result := 'parI';
280    parS:      parS:
281          result:='parS';        result := 'parS';
282    _I:      _I:
283          result:='I';        result := 'I';
284    _S:      _S:
285          result:='S';        result := 'S';
286    _V:      _V:
287          result:='V';        result := 'V';
288    else    else
289          result:=IntToStr(k);      result := IntToStr(k);
290    end;    end;
291  end;  end;
292    
293  { TTable }  { TTable }
294    
295  constructor TTable.Create(const id: string; const k, l, a: integer);  constructor TTable.Create(const Id: string; const k, l, a: integer);
296  begin  begin
297          inherited Create;    inherited Create;
298          name:=id;    name := Id;
299          kind:=k;    kind := k;
300          raddr.level:=l;    Raddr.level := l;
301          raddr.addr:=a;    Raddr.addr := a;
302  end;  end;
303    
304  constructor TTable.Create(const id: string);  constructor TTable.Create(const Id: string);
305  begin  begin
306          inherited Create;    inherited Create;
307          name:=id;    name := Id;
308  end;  end;
309    
310  function TTable.toString: string;  function TTable.toString: string;
311  begin  begin
312          result:=name+' : '+hyouji(kind)+' : '+IntToStr(raddr.level)+IntToStr(raddr.addr);    result := name + ' : ' + hyouji(kind) + ' : ' + IntToStr(Raddr.level) +
313        IntToStr(Raddr.addr);
314  end;  end;
315    
316  { TTableArray }  { TTableArray }
317    
318  constructor TTableArray.Create(const id: string; const k, l, a, j, g,  constructor TTableArray.Create(const Id: string;
319    r: integer);    const k, l, a, j, g, r: integer);
320  begin  begin
321          inherited Create(id,k,l,a);    inherited Create(Id, k, l, a);
322          jigen:=j;    jigen := j;
323          gyou:=g;    gyou := g;
324          retu:=r;    retu := r;
325  end;  end;
326    
327  function TTableArray.toString: string;  function TTableArray.toString: string;
328  begin  begin
329          result:=inherited toString+' : '+IntToStr(jigen)+'次元: '+IntToStr(gyou)+    result := inherited toString + ' : ' + IntToStr(jigen) + '次元: ' +
330                  IntToStr(retu)+'列';      IntToStr(gyou) + IntToStr(retu) + '列';
331  end;  end;
332    
333  { TCellG }  { TCellG }
334    
335  function TCellG.bLevel: integer;  function TCellG.bLevel: integer;
336  begin  begin
337          result:=level;    result := level;
338  end;  end;
339    
340  procedure TCellG.blockBegin;  procedure TCellG.blockBegin;
341  begin  begin
342    if level = -1 then    if level = -1 then
343    begin    begin
344          localAddr:=firstAddr;      localAddr := firstAddr;
345          slocalAddr:=0;      slocalAddr := 0;
346          tIndex:=0;      tIndex := 0;
347          inc(level);      inc(level);
348    end else    end
349          if level = MaxLevel-1 then    else if level = MaxLevel - 1 then
350    begin      error('ブロックが深すぎます')
351          error('ブロックが深すぎます');    else
   end else  
352    begin    begin
353          index[level]:=tIndex;      index[level] := tIndex;
354          addr[level]:=localAddr;      addr[level] := localAddr;
355          saddr[level]:=slocalAddr;      saddr[level] := slocalAddr;
356          localAddr:=firstAddr;      localAddr := firstAddr;
357          slocalAddr:=0;      slocalAddr := 0;
358          inc(level);      inc(level);
359    end;    end;
360  end;  end;
361    
# Line 357  var Line 365  var
365  begin  begin
366    if pTable = true then    if pTable = true then
367    begin    begin
368          Writeln('--level : '+IntToStr(level)+'--');      Writeln('--level : ' + IntToStr(level) + '--');
369      if level = 0 then      if level = 0 then
370      begin        i := 1
371          i:=1;      else
372      end else        i := index[level - 1] + 1;
373      begin      for j := i to tIndex do
374          i:=index[level-1]+1;        Writeln(nameTable[j].toString);
375      end;      for j := tfIndex to fIndex do
     for j:=i to tIndex do  
     begin  
         Writeln(nameTable[j].toString);  
     end;  
     for j:=tfIndex to fIndex do  
376      begin      begin
377        if fIndex = 0 then        if fIndex = 0 then
378        begin          break;
379                  break;        Writeln(funcTable[j].toString);
       end;  
         Writeln(funcTable[j].toString);  
380      end;      end;
381          Writeln;      Writeln;
382    end;    end;
383    if level = 0 then    if level = 0 then
384        dec(level)
385      else
386    begin    begin
387          dec(level);      dec(level);
388    end else      for i := index[level] + 1 to tIndex do
389    begin        nameTable[i].Free;
390          dec(level);      tIndex := index[level];
391      for i:=index[level]+1 to tIndex do      localAddr := addr[level];
392      begin      slocalAddr := saddr[level];
         nameTable[i].Free;  
     end;  
         tIndex:=index[level];  
         localAddr:=addr[level];  
         slocalAddr:=saddr[level];  
393    end;    end;
394  end;  end;
395    
# Line 399  function TCellG.checkGet(t: TToken; cons Line 397  function TCellG.checkGet(t: TToken; cons
397  begin  begin
398    if t.kind <> k then    if t.kind <> k then
399    begin    begin
400          error('入力間違いです-'+key[k]);      error('入力間違いです-' + key[k]);
401          result:=t;      result := t;
402    end else    end
403    begin    else
404          result:=makeToken;      result := makeToken;
   end;  
405  end;  end;
406    
407  function TCellG.checkIn(const n: string): Boolean;  function TCellG.checkIn(const n: string): Boolean;
# Line 412  var Line 409  var
409    i, j: integer;    i, j: integer;
410  begin  begin
411    if Length(n) = 0 then    if Length(n) = 0 then
412        result := true
413      else
414    begin    begin
415          result:=true;      result := false;
416    end else      for i := 1 to Length(n) do
   begin  
         result:=false;  
     for i:=1 to Length(n) do  
417      begin      begin
418          j:=cClass(n[i]);        j := cClass(n[i]);
419        if j <> digit then        if j <> digit then
420        begin        begin
421                  result:=true;          result := true;
422                  break;          break;
423        end;        end;
424      end;      end;
425    end;    end;
# Line 432  end; Line 428  end;
428  procedure TCellG.closeFile;  procedure TCellG.closeFile;
429  begin  begin
430    try    try
431          System.CloseFile(BufferedReader);      System.closeFile(BufferedReader);
432    except    except
433      on EInOutError do Writeln('ファイルを閉じられません');      on EInOutError do
434          Writeln('ファイルを閉じられません');
435    end;    end;
436  end;  end;
437    
438  constructor TCellG.Create(p: Boolean);  constructor TCellG.Create(p: Boolean);
439  begin  begin
440          inherited Create;    inherited Create;
441          pTable:=p;    pTable := p;
442          lastT:=TToken.Create;    lastT := TToken.Create;
443          initKey;    initKey;
444          shokika;    shokika;
445  end;  end;
446    
447  destructor TCellG.Destroy;  destructor TCellG.Destroy;
448  begin  begin
449          lastT.Free;    lastT.Free;
450          nameTable[0].Free;    nameTable[0].Free;
451          moduleTable[0].Free;    moduleTable[0].Free;
452          inherited;    inherited;
453  end;  end;
454    
455  procedure TCellG.endPar;  procedure TCellG.endPar;
456  var  var
457    i, pI, pS: integer;    i, pi, ps: integer;
458  begin  begin
459    with funcTable[tfIndex] as TTableFunc do    with funcTable[tfIndex] as TTableFunc do
460    begin    begin
461          pI:=parIs;      pi := parIs;
462          pS:=parSs;      ps := parSs;
   end;  
   if (pI = 0)and(pS = 0) then  
   begin  
         Exit;  
463    end;    end;
464    for i:=tfIndex+1 to tfIndex+pI+pS do    if (pi = 0) and (ps = 0) then
465        Exit;
466      for i := tfIndex + 1 to tfIndex + pi + ps do
467    begin    begin
468      if funcTable[i].kind = parI then      if funcTable[i].kind = parI then
469      begin      begin
470          funcTable[i].Raddr.addr:=-pI;        funcTable[i].Raddr.addr := -pi;
471          dec(pI);        dec(pi);
472      end else      end
473        else
474      begin      begin
475          funcTable[i].Raddr.addr:=-pS;        funcTable[i].Raddr.addr := -ps;
476          dec(pS);        dec(ps);
477      end;      end;
478    end;    end;
479  end;  end;
480    
481  procedure TCellG.error(const er: string);  procedure TCellG.error(const er: string);
482  begin  begin
483          inc(e);    inc(e);
484          Writeln(IntToStr(cr)+' : '+errorLine+' : '+er+'。');    Writeln(IntToStr(cr) + ' : ' + errorLine + ' : ' + er + '。');
485          errorLine:='';    errorLine := '';
486  end;  end;
487    
488  function TCellG.fModori(n: integer): integer;  function TCellG.fModori(n: integer): integer;
489  begin  begin
490          result:=(funcTable[n-tIndex] as TTableFunc).modori;    result := (funcTable[n - tIndex] as TTableFunc).modori;
491  end;  end;
492    
493  function TCellG.funcParIs: integer;  function TCellG.funcParIs: integer;
494  begin  begin
495          result:=(funcTable[tfIndex] as TTableFunc).parIs;    result := (funcTable[tfIndex] as TTableFunc).parIs;
496  end;  end;
497    
498  function TCellG.hairetu(const n: integer): TRaddr;  function TCellG.hairetu(const n: integer): TRaddr;
499  begin  begin
500    with nameTable[n] as TTableArray do    with nameTable[n] as TTableArray do
501    begin    begin
502          result.level:=gyou;      result.level := gyou;
503          result.addr:=retu;      result.addr := retu;
504    end;    end;
505  end;  end;
506    
507  procedure TCellG.initKey;  procedure TCellG.initKey;
508  begin  begin
509          key[_aI]:='aI';    key[_aI] := 'aI';
510          key[_Print]:='print';    key[_Print] := 'print';
511          key[_Println]:='println';    key[_Println] := 'println';
512          key[_Read]:='read';    key[_Read] := 'read';
513          key[_ReadS]:='reads';    key[_ReadS] := 'reads';
514          key[_If]:='if';    key[_If] := 'if';
515          key[_Else]:='else';    key[_Else] := 'else';
516          key[_For]:='for';    key[_For] := 'for';
517          key[_While]:='while';    key[_While] := 'while';
518          key[_Do]:='do';    key[_Do] := 'do';
519          key[_I]:='i';    key[_I] := 'i';
520          key[_S]:='s';    key[_S] := 's';
521          key[_V]:='v';    key[_V] := 'v';
522          key[_Return]:='return';    key[_Return] := 'return';
523          key[_Break]:='break';    key[_Break] := 'break';
524          key[_end_KeyWd]:='dummy1';    key[_end_KeyWd] := 'dummy1';
525          key[_Plus]:='+';    key[_Plus] := '+';
526          key[_Minus]:='-';    key[_Minus] := '-';
527          key[_Mult]:='*';    key[_Mult] := '*';
528          key[_Equal]:='=';    key[_Equal] := '=';
529          key[_Comma]:=',';    key[_Comma] := ',';
530          key[_Semicolon]:=':';    key[_Semicolon] := ':';
531          key[_Lparen]:='(';    key[_Lparen] := '(';
532          key[_Rparen]:=')';    key[_Rparen] := ')';
533          key[_Lbrace]:='{';    key[_Lbrace] := '{';
534          key[_Rbrace]:='}';    key[_Rbrace] := '}';
535          key[_LBracket]:='[';    key[_Lbracket] := '[';
536          key[_Rbracket]:=']';    key[_Rbracket] := ']';
537          key[_Lss]:='<';    key[_Lss] := '<';
538          key[_Gtr]:='>';    key[_Gtr] := '>';
539          key[_LssEq]:='<=';    key[_LssEq] := '<=';
540          key[_GtrEq]:='>=';    key[_GtrEq] := '>=';
541          key[_NotEq]:='!=';    key[_NotEq] := '!=';
542          key[_Ex]:='!';    key[_Ex] := '!';
543          key[_end_Sym]:='dummy2';    key[_end_Sym] := 'dummy2';
544  end;  end;
545    
546  function TCellG.jigen(const i: integer): integer;  function TCellG.jigen(const i: integer): integer;
547  begin  begin
548          result:=TTableArray(nameTable[i]).jigen;    result := TTableArray(nameTable[i]).jigen;
549  end;  end;
550    
551  function TCellG.makeToken: TToken;  function TCellG.makeToken: TToken;
552  var  var
553    i: integer;    i: integer;
554    cc, k: integer;    cc, k: integer;
555    num: integer;    Num: integer;
556    temp: TToken;    temp: TToken;
557    id: string;    Id: string;
558  begin  begin
559          temp:=TToken.Create;    temp := TToken.Create;
560    while true do    while true do
561    begin    begin
562          k:=lastT.kind;      k := lastT.kind;
563      if k <> nul then      if k <> nul then
564      begin      begin
565        if k < _end_Sym then        if k < _end_Sym then
566        begin          errorLine := errorLine + key[lastT.kind]
567                  errorLine:=errorLine+key[lastT.kind];        else if k = CellG.Num then
568        end else          errorLine := errorLine + IntToStr(lastT.value)
569          if k = CellG.Num then        else if k = CellG.Id then
570        begin          errorLine := errorLine + lastT.Id;
                 errorLine:=errorLine+IntToStr(lastT.value);  
       end else  
         if k = CellG.Id then  
       begin  
                 errorLine:=errorLine+lastT.id;  
       end;  
571      end;      end;
572          cc:=cClass(c);      cc := cClass(c);
573      while (cc = space)or(cc = cr1)or(cc = tab) do      while (cc = space) or (cc = cr1) or (cc = tab) do
574      begin      begin
575        if (cc = space)or(cc = tab) then        if (cc = space) or (cc = tab) then
576        begin          errorLine := errorLine + c;
                 errorLine:=errorLine+c;  
       end;  
577        if cc = cr1 then        if cc = cr1 then
578        begin        begin
579                  inc(cr);          inc(cr);
580                  errorLine:='';          errorLine := '';
581        end;        end;
582          c:=nextChar;        c := nextChar;
583          cc:=cClass(c);        cc := cClass(c);
584      end;      end;
585      case cc of      case cc of
586      digit:        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  
587          begin          begin
588                  id:=id+c;            Num := 0;
589              while cc = digit do
590              begin
591                Num := 10 * Num + StrToInt(c);
592                c := nextChar;
593                cc := cClass(c);
594              end;
595              temp.kind := CellG.Num;
596              temp.value := Num;
597              break;
598          end;          end;
599                  c:=nextChar;        letter, others:
                 cc:=cClass(c);  
       end;  
       if Length(id) >= MaxName then  
       begin  
                 error('名前が長すぎです');  
       end;  
       for i:=0 to _end_KeyWd do  
       begin  
         if CompareText(id,key[i]) = 0 then  
600          begin          begin
601                  temp.kind:=i;            Id := '';
602                  temp.id:=id;            while (cc = letter) or (cc = digit) or (cc = others) do
603                  lastT.Free;            begin
604                  lastT:=temp;              if Length(Id) < MaxName then
605                  result:=temp;                Id := Id + c;
606                  Exit;              c := nextChar;
607                cc := cClass(c);
608              end;
609              if Length(Id) >= MaxName then
610                error('名前が長すぎです');
611              for i := 0 to _end_KeyWd do
612                if CompareText(Id, key[i]) = 0 then
613                begin
614                  temp.kind := i;
615                  temp.Id := Id;
616                  lastT.Free;
617                  lastT := temp;
618                  result := temp;
619                  Exit;
620                end;
621              temp.kind := CellG.Id;
622              temp.Id := Id;
623              break;
624          end;          end;
625        end;        _Equal:
         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  
626          begin          begin
627                  mojiretu:=mojiretu+c;            c := nextChar;
628              if c = '=' then
629              begin
630                temp.kind := _Equal2;
631                c := nextChar;
632              end
633              else
634                temp.kind := _Equal;
635              break;
636            end;
637          _Ex:
638            begin
639              c := nextChar;
640              if c = '=' then
641              begin
642                temp.kind := _NotEq;
643                c := nextChar;
644              end
645              else
646                temp.kind := _Ex;
647              break;
648            end;
649          _Lss:
650            begin
651              c := nextChar;
652              if c = '=' then
653              begin
654                temp.kind := _LssEq;
655                c := nextChar;
656              end
657              else
658                temp.kind := _Lss;
659              break;
660            end;
661          _Gtr:
662            begin
663              c := nextChar;
664              if c = '=' then
665              begin
666                temp.kind := _GtrEq;
667                c := nextChar;
668              end
669              else
670                temp.kind := _Gtr;
671              break;
672            end;
673          _Plus:
674            begin
675              c := nextChar;
676              if c = '+' then
677              begin
678                temp.kind := _Plus2;
679                c := nextChar;
680              end
681              else
682                temp.kind := _Plus;
683              break;
684            end;
685          _Minus:
686            begin
687              c := nextChar;
688              if c = '-' then
689              begin
690                temp.kind := _Minus2;
691                c := nextChar;
692              end
693              else
694                temp.kind := _Minus;
695              break;
696            end;
697          at:
698            begin
699              c := nextChar;
700              cc := cClass(c);
701              while cc <> at do
702              begin
703                errorLine := errorLine + c;
704                c := nextChar;
705                cc := cClass(c);
706              end;
707              c := nextChar;
708              continue;
709            end;
710          _DQ:
711            begin
712              i := 1;
713              mojiretu := '';
714              repeat
715                if i < MaxMoji then
716                  mojiretu := mojiretu + c;
717                inc(i);
718                c := nextChar;
719                cc := cClass(c);
720              until (cc = _DQ) or (cc = _Rbrace) or (cc = _Semicolon);
721              if (cc = _Rbrace) or (cc = _Semicolon) then
722              begin
723                error('"がありません。');
724                temp.kind := cc;
725                lastT := temp;
726                result := temp;
727                Exit;
728              end;
729              if i >= MaxMoji then
730              begin
731                error('文字が多すぎです');
732                i := MaxName - 1;
733              end;
734              mojiretu := mojiretu + '"';
735              temp.kind := Moji;
736              temp.Id := Copy(mojiretu, 2, i - 2);
737              c := nextChar;
738              break;
739            end;
740          dollar:
741            begin
742              checkKan;
743              temp.kind := dollar;
744              break;
745          end;          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('"がありません。');  
                 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;  
746      else      else
747          temp.kind:=cc;        temp.kind := cc;
748          c:=nextChar;        c := nextChar;
749          break;        break;
750      end;      end;
751    end;    end;
752          lastT.Free;    lastT.Free;
753          lastT:=temp;    lastT := temp;
754          result:=temp;    result := temp;
755  end;  end;
756    
757  function TCellG.nextChar: Char;  function TCellG.nextChar: Char;
# Line 786  begin Line 760  begin
760    begin    begin
761      if Eof(BufferedReader) = true then      if Eof(BufferedReader) = true then
762      begin      begin
763          Writeln(IntToStr(cr)+':ファイル終了、$がありません。'+IntToStr(e),'エラー個数:'+IntToStr(e+1));        Writeln(IntToStr(cr) + ':ファイル終了、$がありません。' + IntToStr(e),
764          System.CloseFile(BufferedReader);          'エラー個数:' + IntToStr(e + 1));
765          System.closeFile(BufferedReader);
766        raise EInOutError.Create('error');        raise EInOutError.Create('error');
767      end;      end;
768          lineIndex:=1;      lineIndex := 1;
769      try      try
770          Readln(BufferedReader,line);        Readln(BufferedReader, line);
771      except      except
772          Writeln(IntToStr(cr)+'次の行を取得できません。'+' : '+IntToStr(e),        Writeln(IntToStr(cr) + '次の行を取得できません。' + ' : ' + IntToStr(e),
773                  'エラー個数:'+IntToStr(e+1));          'エラー個数:' + IntToStr(e + 1));
774        raise;        raise;
775      end;      end;
776          result:=#13;      result := #13;
777    end else    end
778      else
779    begin    begin
780          result:=line[lineIndex];      result := line[lineIndex];
781          inc(lineIndex);      inc(lineIndex);
782    end;    end;
783  end;  end;
784    
785  function TCellG.numAddr: integer;  function TCellG.numAddr: integer;
786  begin  begin
787          result:=localAddr;    result := localAddr;
788  end;  end;
789    
790  function TCellG.snumAddr: integer;  function TCellG.snumAddr: integer;
791  begin  begin
792          result:=slocalAddr;    result := slocalAddr;
793  end;  end;
794    
795  function TCellG.open(const f: TFileName; cellV: TObject): Boolean;  function TCellG.open(const f: TFileName; cellV: TObject): Boolean;
796  begin  begin
797          _cellV:=cellV as TCellV;    _cellV := cellV as TCellV;
798    if FileExists(f) = false then    if FileExists(f) = false then
799    begin    begin
800          result:=false;      result := false;
801          Exit;      Exit;
802    end;    end;
803    try    try
804          AssignFile(BufferedReader,f);      AssignFile(BufferedReader, f);
805          Reset(BufferedReader);      Reset(BufferedReader);
806          Readln(BufferedReader,line);      Readln(BufferedReader, line);
807          lineIndex:=1;      lineIndex := 1;
808          c:=nextChar;      c := nextChar;
809          lastT.kind:=nul;      lastT.kind := nul;
810          result:=true;      result := true;
811    except    except
812      on EInOutError do      on EInOutError do
813      begin      begin
814          Writeln('ファイルを開けません');        Writeln('ファイルを開けません');
815          result:=false;        result := false;
816      end;      end;
817    end;    end;
818  end;  end;
819    
820  function TCellG.pKazuI(const n: integer): integer;  function TCellG.pKazuI(const n: integer): integer;
821  begin  begin
822          result:=(funcTable[n-tIndex] as TTableFunc).parIs;    result := (funcTable[n - tIndex] as TTableFunc).parIs;
823  end;  end;
824    
825  function TCellG.searchF(const id: string; m: integer): integer;  function TCellG.searchF(const Id: string; m: integer): integer;
826  var  var
827    i, j: integer;    i, j: integer;
828  begin  begin
829          i:=moduleTable[m].index;    i := moduleTable[m].index;
830          result:=0;    result := 0;
831    for j:=0 to moduleTable[m].number-1 do    for j := 0 to moduleTable[m].number - 1 do
832    begin      if funcTable[i + j].name = Id then
833      if funcTable[i+j].name = id then        result := i + j + tIndex;
     begin  
         result:=i+j+tIndex;  
     end;  
   end;  
834  end;  end;
835    
836  function TCellG.searchT(const id: string): integer;  function TCellG.searchT(const Id: string): integer;
837  var  var
838    i: integer;    i: integer;
839  begin  begin
840          result:=0;    result := 0;
841          nameTable[0].name:=id;    nameTable[0].name := Id;
842    for i:=tIndex downto 0 do    for i := tIndex downto 0 do
843    begin      if Id = nameTable[i].name then
     if id = nameTable[i].name then  
844      begin      begin
845          result:=i;        result := i;
846          break;        break;
847      end;      end;
   end;  
848    if result = 0 then    if result = 0 then
849    begin      result := searchF(Id, mIndex);
         result:=searchF(id,mIndex);  
   end;  
850  end;  end;
851    
852  procedure TCellG.setFunc(t: TTable);  procedure TCellG.setFunc(t: TTable);
853  begin  begin
854    if fIndex < (MaxTable div 2) then    if fIndex < (MaxTable div 2) then
855    begin    begin
856          inc(fIndex);      inc(fIndex);
857          funcTable[fIndex]:=t;      funcTable[fIndex] := t;
858          inc(moduleTable[mIndex].number);      inc(moduleTable[mIndex].number);
859    end else    end
860    begin    else
861          error('関数が多すぎです');      error('関数が多すぎです');
   end;  
862  end;  end;
863    
864  procedure TCellG.setModule(id: string);  procedure TCellG.setModule(Id: string);
865  begin  begin
866          inc(mIndex);    inc(mIndex);
867    if mIndex < MaxModule then    if mIndex < MaxModule then
868    begin      moduleTable[mIndex] := TModule.Create(Id, fIndex + 1, 0)
869          moduleTable[mIndex]:=TModule.Create(id,fIndex+1,0);    else
870    end else      error('モジュールが多すぎです');
   begin  
         error('モジュールが多すぎです');  
   end;  
871  end;  end;
872    
873  procedure TCellG.setTable(t: TTable);  procedure TCellG.setTable(t: TTable);
874  begin  begin
875    if tIndex < MaxTable then    if tIndex < MaxTable then
876    begin    begin
877          inc(tIndex);      inc(tIndex);
878          nameTable[tIndex]:=t;      nameTable[tIndex] := t;
879    end else    end
880    begin    else
881          error('変数が多すぎです');      error('変数が多すぎです');
   end;  
882  end;  end;
883    
884  function TCellG.tableA1int(const id: string; const n: integer): integer;  function TCellG.tableA1int(const Id: string; const n: integer): integer;
885  begin  begin
886          setTable(TTableArray.Create(id,arrI,level,localAddr,1,0,n));    setTable(TTableArray.Create(Id, arrI, level, localAddr, 1, 0, n));
887          inc(localAddr,n);    inc(localAddr, n);
888          result:=tIndex;    result := tIndex;
889  end;  end;
890    
891  function TCellG.tableA2int(const id: string; const x, v: integer): integer;  function TCellG.tableA2int(const Id: string; const x, v: integer): integer;
892  begin  begin
893          setTable(TTableArray.Create(id,arrI,level,localAddr,2,x,v));    setTable(TTableArray.Create(Id, arrI, level, localAddr, 2, x, v));
894          inc(localAddr,x*v);    inc(localAddr, x * v);
895          result:=tIndex;    result := tIndex;
896  end;  end;
897    
898  function TCellG.tableFunc(const id: string; const c, mm: integer): integer;  function TCellG.tableFunc(const Id: string; const c, mm: integer): integer;
899  begin  begin
900          setFunc(TTableFunc.Create(id,funID,level,c,mm,0,0));    setFunc(TTableFunc.Create(Id, funID, level, c, mm, 0, 0));
901          tfIndex:=fIndex;    tfIndex := fIndex;
902          result:=fIndex+tIndex;    result := fIndex + tIndex;
903  end;  end;
904    
905  function TCellG.tableInt(const id: string): integer;  function TCellG.tableInt(const Id: string): integer;
906  begin  begin
907          setTable(TTable.Create(id,intID,level,localAddr));    setTable(TTable.Create(Id, intID, level, localAddr));
908          inc(localAddr);    inc(localAddr);
909          result:=tIndex;    result := tIndex;
910  end;  end;
911    
912  function TCellG.tableString(id: string): integer;  function TCellG.tableString(Id: string): integer;
913  begin  begin
914          setTable(TTable.Create(id,strID,level,slocalAddr));    setTable(TTable.Create(Id, strID, level, slocalAddr));
915          inc(slocalAddr);    inc(slocalAddr);
916          result:=tIndex;    result := tIndex;
917  end;  end;
918    
919  function TCellG.tablePint(const id: string): integer;  function TCellG.tablePint(const Id: string): integer;
920  begin  begin
921          setFunc(TTable.Create(id,parI,level,0));    setFunc(TTable.Create(Id, parI, level, 0));
922          inc((funcTable[tfIndex] as TTableFunc).parIs);    inc((funcTable[tfIndex] as TTableFunc).parIs);
923          result:=fIndex+tIndex;    result := fIndex + tIndex;
924  end;  end;
925    
926  function TCellG.tablePstr(id: string): integer;  function TCellG.tablePstr(Id: string): integer;
927  begin  begin
928          setFunc(TTable.Create(id,parS,level,0));    setFunc(TTable.Create(Id, parS, level, 0));
929          inc((FuncTable[tfIndex] as TTableFunc).parSs);    inc((funcTable[tfIndex] as TTableFunc).parSs);
930          result:=fIndex+tIndex;    result := fIndex + tIndex;
931  end;  end;
932    
933  function TCellG.tAddr(const n: integer): TRaddr;  function TCellG.tAddr(const n: integer): TRaddr;
934  begin  begin
935    if n > tIndex then    if n > tIndex then
936    begin      result := funcTable[n - tIndex].Raddr
937          result:=funcTable[n-tIndex].Raddr;    else
938    end else      result := nameTable[n].Raddr;
   begin  
         result:=nameTable[n].Raddr;  
   end;  
939  end;  end;
940    
941  function TCellG.tKind(const n: integer): integer;  function TCellG.tKind(const n: integer): integer;
942  begin  begin
943    if n = 0 then    if n = 0 then
944    begin      result := 0
945          result:=0;    else if n > tIndex then
946    end else      result := funcTable[n - tIndex].kind
947          if n > tIndex then    else
948    begin      result := nameTable[n].kind;
         result:=funcTable[n-tIndex].kind;  
   end else  
   begin  
         result:=nameTable[n].kind;  
   end;  
949  end;  end;
950    
951  function TCellG.cClass(c: Char): integer;  function TCellG.cClass(c: Char): integer;
952  var  var
953    small, big, m: integer;    small, big, m: integer;
954  begin  begin
955          result:=others;    result := others;
956          small:=0;    small := 0;
957          big:=High(fClass);    big := High(fClass);
958    while small <= big do    while small <= big do
959    begin    begin
960          m:=(small+big) div 2;      m := (small + big) div 2;
961      if c < fClass[m].small then      if c < fClass[m].small then
962          big := m - 1
963        else if c > fClass[m].big then
964          small := m + 1
965        else
966      begin      begin
967          big:=m-1;        result := fClass[m].result;
968      end else        break;
         if c > fClass[m].big then  
     begin  
         small:=m+1;  
     end else  
     begin  
         result:=fClass[m].result;  
         break;  
969      end;      end;
970    end;    end;
971  end;  end;
# Line 1023  var Line 975  var
975    i: integer;    i: integer;
976    s: TTable;    s: TTable;
977  begin  begin
978          s:=nameTable[t];    s := nameTable[t];
979    if s.kind = k then    if s.kind = k then
980    begin      Exit;
981          Exit;    s.kind := k;
   end;  
         s.kind:=k;  
982    if x = true then    if x = true then
983    begin      i := level - 1
984          i:=level-1;    else
985    end else      i := level;
   begin  
         i:=level;  
   end;  
986    if k = intID then    if k = intID then
987    begin    begin
988      if i = s.Raddr.level then      if i = s.Raddr.level then
989      begin      begin
990          s.Raddr.addr:=localAddr;        s.Raddr.addr := localAddr;
991          inc(localAddr);        inc(localAddr);
992          dec(slocalAddr);        dec(slocalAddr);
993      end else      end
994        else
995      begin      begin
996          s.Raddr.level:=addr[s.Raddr.level];        s.Raddr.level := addr[s.Raddr.level];
997          inc(addr[s.Raddr.level]);        inc(addr[s.Raddr.level]);
998          dec(saddr[s.Raddr.level]);        dec(saddr[s.Raddr.level]);
999      end;      end;
1000    end else    end
1001          if k = strID then    else if k = strID then
1002    begin    begin
1003      if i = s.Raddr.level then      if i = s.Raddr.level then
1004      begin      begin
1005          s.Raddr.addr:=slocalAddr;        s.Raddr.addr := slocalAddr;
1006          inc(slocalAddr);        inc(slocalAddr);
1007          dec(localAddr);        dec(localAddr);
1008      end else      end
1009        else
1010      begin      begin
1011          s.Raddr.level:=saddr[s.Raddr.level];        s.Raddr.level := saddr[s.Raddr.level];
1012          inc(saddr[s.Raddr.level]);        inc(saddr[s.Raddr.level]);
1013          dec(addr[s.Raddr.level]);        dec(addr[s.Raddr.level]);
1014      end;      end;
1015    end;    end;
1016  end;  end;
1017    
1018  function TCellG.moduleName: string;  function TCellG.moduleName: string;
1019  begin  begin
1020          result:=moduleTable[mIndex].name;    result := moduleTable[mIndex].name;
1021  end;  end;
1022    
1023  function TCellG.nextTIndex: integer;  function TCellG.nextTIndex: integer;
1024  begin  begin
1025          result:=tIndex+1;    result := tIndex + 1;
1026  end;  end;
1027    
1028  function TCellG.searchFModule(m, id: string): integer;  function TCellG.searchFModule(m, Id: string): integer;
1029  var  var
1030    i: integer;    i: integer;
1031  begin  begin
1032          result:=-1;    result := -1;
1033          moduleTable[0].name:=m;    moduleTable[0].name := m;
1034    for i:=mIndex downto 0 do    for i := mIndex downto 0 do
   begin  
1035      if m = moduleTable[i].name then      if m = moduleTable[i].name then
1036      begin        result := i;
         result:=i;  
     end;  
   end;  
1037    if result >= 0 then    if result >= 0 then
1038    begin      result := searchF(Id, result);
         result:=searchF(id,result);  
   end;  
1039  end;  end;
1040    
1041  function TCellG.pKazuS(n: integer): integer;  function TCellG.pKazuS(n: integer): integer;
1042  begin  begin
1043          result:=(funcTable[n-tIndex] as TTableFunc).parSs;    result := (funcTable[n - tIndex] as TTableFunc).parSs;
1044  end;  end;
1045    
1046  function TCellG.funcModori: integer;  function TCellG.funcModori: integer;
1047  begin  begin
1048          result:=(funcTable[tfIndex] as TTableFunc).modori;    result := (funcTable[tfIndex] as TTableFunc).modori;
1049  end;  end;
1050    
1051  procedure TCellG.setKariTable(id, m: string; s, ti, lc, pi, ps, c: integer);  procedure TCellG.setKariTable(Id, m: string; s, tI, lc, pi, ps, c: integer);
1052  begin  begin
1053    if kIndex < (MaxTable div 4) then    if kIndex < (MaxTable div 4) then
1054    begin    begin
1055          inc(kIndex);      inc(kIndex);
1056          kariTable[kIndex]:=TKari.Create(id,m,s,ti,lc,0,pi,ps,c,false);      kariTable[kIndex] := TKari.Create(Id, m, s, tI, lc, 0, pi, ps, c, false);
1057    end else    end
1058    begin    else
1059          error('関数を先に定義してください');      error('関数を先に定義してください')
   end;  
1060  end;  end;
1061    
1062  procedure TCellG.shokika;  procedure TCellG.shokika;
1063  var  var
1064    i: integer;    i: integer;
1065  begin  begin
1066    for i:=0 to tIndex do    for i := 0 to tIndex do
1067    begin      nameTable[i].Free;
1068          nameTable[i].Free;    for i := 0 to fIndex do
1069    end;      funcTable[i].Free;
1070    for i:=0 to fIndex do    for i := 0 to kIndex do
1071    begin      kariTable[i].Free;
1072          funcTable[i].Free;    for i := 0 to mIndex do
1073    end;      moduleTable[i].Free;
1074    for i:=0 to kIndex do    kan := -1;
1075    begin    tIndex := 0;
1076          kariTable[i].Free;    tfIndex := 0;
1077    end;  
1078    for i:=0 to mIndex do    localAddr := 0;
1079    begin    slocalAddr := 0;
1080          moduleTable[i].Free;    e := 0;
1081    end;    errorLine := '';
1082          kan:=-1;  
1083          tIndex:=0;    level := -1;
1084          tfIndex:=0;    kIndex := -1;
1085      fIndex := 0;
1086          localAddr:=0;    mIndex := -1;
1087          slocalAddr:=0;    cr := 1;
1088          e:=0;    nameTable[0] := TTable.Create;
1089          errorline:='';    moduleTable[0] := TModule.Create;
   
         level:=-1;  
         kIndex:=-1;  
         fIndex:=0;  
         mIndex:=-1;  
         cr:=1;  
         nameTable[0]:=TTable.Create;  
         moduleTable[0]:=TModule.Create;  
1090  end;  end;
1091    
1092  procedure TCellG.checkKari(id: string);  procedure TCellG.checkKari(Id: string);
1093  var  var
1094    i: integer;    i: integer;
1095    s: string;    s: string;
# Line 1163  var Line 1097  var
1097    var    var
1098      j: integer;      j: integer;
1099    begin    begin
1100          j:=(funcTable[tfIndex] as TTableFunc).modori;      j := (funcTable[tfIndex] as TTableFunc).modori;
1101      if j = _V then      if j = _V then
     begin  
1102        if kariTable[i].sahen <> 0 then        if kariTable[i].sahen <> 0 then
1103            error('呼び出し文に代入するものがありません。')
1104          else if j = _I then
1105        begin        begin
1106                  error('呼び出し文に代入するものがありません。');          case kariTable[i].sahen of
1107        end;            strID:
1108      end else              begin
1109          if j = _I then                changeT(kariTable[i].tI, intID, true);
1110      begin                _cellV.backPatchL(kariTable[i].lcI, kariTable[i].tI, 0);
1111        case kariTable[i].sahen of                _cellV.changeS(kariTable[i].scI, 0);
1112        strID:              end;
1113        begin            parS:
1114                  changeT(kariTable[i].tI,intID,true);              error('呼び出し文の型が一致しません。');
1115                  _cellV.backPatchL(kariTable[i].lcI,kariTable[i].tI,0);          end;
1116                  _cellV.changeS(kariTable[i].scI,0);        end
1117        end;        else if j = _S then
1118        parS:          case kariTable[i].sahen of
1119                  error('呼び出し文の型が一致しません。');            intID:
1120        end;              begin
1121      end else                changeT(kariTable[i].tI, strID, true);
1122          if j = _S then                _cellV.backPatchL(kariTable[i].lcI, kariTable[i].tI, 1);
1123      begin                _cellV.changeS(kariTable[i].scI, 1);
1124        case kariTable[i].sahen of              end;
1125        intID:            arrI, parI:
1126        begin              error('呼び出し文の型が一致しません。');
1127                  changeT(kariTable[i].tI,strID,true);          end;
1128                  _cellV.backPatchL(kariTable[i].lcI,kariTable[i].tI,1);      if (funcTable[tfIndex] as TTableFunc).parIs <> kariTable[i].pi then
1129                  _cellV.changeS(kariTable[i].scI,1);        error('呼び出し文の引数(I)に誤りがあります。');
1130        end;      if (funcTable[tfIndex] as TTableFunc).parSs <> kariTable[i].ps then
1131        arrI,parI:        error('呼び出し文の引数(S)に誤りがあります。');
1132                  error('呼び出し文の型が一致しません。');      _cellV.backCal(kariTable[i].cI, level - 1, funcTable[tfIndex].Raddr.addr);
1133        end;      kariTable[i].tf := true;
1134      end;      inc(kan);
     if (funcTable[tfIndex] as TTableFunc).parIs <> kariTable[i].pI then  
     begin  
         error('呼び出し文の引数(I)に誤りがあります。');  
     end;  
     if (funcTable[tfIndex] as TTableFunc).parSs <> kariTable[i].pS then  
     begin  
         error('呼び出し文の引数(S)に誤りがあります。');  
     end;  
         _cellV.backCal(kariTable[i].cI,level-1,funcTable[tfIndex].Raddr.addr);  
         kariTable[i].tf:=true;  
         inc(kan);  
1135    end;    end;
1136    
1137  begin  begin
1138    if kIndex = -1 then    if kIndex = -1 then
1139    begin      Exit;
1140          Exit;    s := moduleTable[mIndex].name;
1141    end;    for i := kIndex downto 0 do
         s:=moduleTable[mIndex].name;  
   for i:=kIndex downto 0 do  
   begin  
1142      if kariTable[i].tf = false then      if kariTable[i].tf = false then
1143      begin        if (Id = kariTable[i].name) and (s = kariTable[i].md) then
1144            main;
       if (id = kariTable[i].name)and(s = kariTable[i].md) then  
       begin  
                 main;  
       end;  
   
     end;  
   end;  
1145  end;  end;
1146    
1147  function TCellG.funcParSs: integer;  function TCellG.funcParSs: integer;
1148  begin  begin
1149          result:=(funcTable[tfIndex] as TTableFunc).parSs;    result := (funcTable[tfIndex] as TTableFunc).parSs;
1150  end;  end;
1151    
1152  procedure TCellG.checkKan;  procedure TCellG.checkKan;
1153  begin  begin
1154    if Kan < kIndex then    if kan < kIndex then
1155    begin      error('定義されていない関数があります');
         error('定義されていない関数があります');  
   end;  
1156  end;  end;
1157    
1158  procedure TCellG.setScI(c: integer);  procedure TCellG.setScI(c: integer);
1159  begin  begin
1160    if kIndex > -1 then    if kIndex > -1 then
1161    begin      kariTable[kIndex].scI := c;
         kariTable[kIndex].scI:=c;  
   end;  
1162  end;  end;
1163    
1164  function TCellG.tableA1str(id: string; n: integer): integer;  function TCellG.tableA1str(Id: string; n: integer): integer;
1165  begin  begin
1166          setTable(TTableArray.Create(id,arrS,level,slocalAddr,1,0,n));    setTable(TTableArray.Create(Id, arrS, level, slocalAddr, 1, 0, n));
1167          inc(slocalAddr,n);    inc(slocalAddr, n);
1168          result:=tIndex;            result := tIndex;
1169  end;  end;
1170    
1171  function TCellG.tableA2str(id: string; x, v: integer): integer;  function TCellG.tableA2str(Id: string; x, v: integer): integer;
1172  begin  begin
1173          setTable(TTableArray.Create(id,arrS,level,slocalAddr,2,x,v));    setTable(TTableArray.Create(Id, arrS, level, slocalAddr, 2, x, v));
1174          inc(slocalAddr,x*v);    inc(slocalAddr, x * v);
1175          result:=tIndex;    result := tIndex;
1176  end;  end;
1177    
1178  { TTableFunc }  { TTableFunc }
1179    
1180  constructor TTableFunc.Create(const id: string; const k, l, a, m,  constructor TTableFunc.Create(const Id: string;
1181    pi, ps: integer);    const k, l, a, m, pi, ps: integer);
1182  begin  begin
1183          inherited Create(id,k,l,a);    inherited Create(Id, k, l, a);
1184          modori:=m;    modori := m;
1185          parIs:=pi;    parIs := pi;
1186          parIs:=ps;    parIs := ps;
1187  end;  end;
1188    
1189  function TTableFunc.toString: string;  function TTableFunc.toString: string;
1190  begin  begin
1191          result:=(inherited toString)+' : '+hyouji(modori)+' : '+IntToStr(parIs)+'pI'+    result := (inherited toString) + ' : ' + hyouji(modori) + ' : ' +
1192            ' : '+IntToStr(parSs)+'pS';      IntToStr(parIs) + 'pI' + ' : ' + IntToStr(parSs) + 'pS';
1193  end;  end;
1194    
1195  { TModule }  { TModule }
1196    
1197  constructor TModule.Create(n: string; i, s: integer);  constructor TModule.Create(n: string; i, s: integer);
1198  begin  begin
1199          inherited Create;    inherited Create;
1200          name:=n;    name := n;
1201          index:=i;    index := i;
1202          number:=s;    number := s;
1203  end;  end;
1204    
1205  constructor TModule.Create(n: string);  constructor TModule.Create(n: string);
1206  begin  begin
1207          inherited Create;    inherited Create;
1208          name:=n;    name := n;
1209  end;  end;
1210    
1211  { TKari }  { TKari }
# Line 1302  end; Line 1213  end;
1213  constructor TKari.Create(n, m: string; s, t, lc, sc, pi, ps, c: integer;  constructor TKari.Create(n, m: string; s, t, lc, sc, pi, ps, c: integer;
1214    f: Boolean);    f: Boolean);
1215  begin  begin
1216          inherited Create;    inherited Create;
1217          name:=n;    name := n;
1218          md:=m;    md := m;
1219          sahen:=s;    sahen := s;
1220          tI:=t;    tI := t;
1221          lcI:=lc;    lcI := lc;
1222          scI:=sc;    scI := sc;
1223          self.pI:=pi;    self.pi := pi;
1224          self.pS:=ps;    self.ps := ps;
1225          cI:=c;    cI := c;
1226          tf:=f;    tf := f;
1227  end;  end;
1228    
1229  end.  end.
Legend:
Removed from v.3  
changed lines
  Added in v.4
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help