Develop and Download Open Source Software

cellcompilerd

Browse Subversion Repository

/[cellcompilerd]/trunk/CellV.pas

Diff of /trunk/CellV.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 86  type Line 86  type
86    private    private
87      level, pI, pS, modori: integer;      level, pI, pS, modori: integer;
88    public    public
89      constructor Create(const op, l, pi, ps, m: integer);      constructor Create(const op, l, pI, pS, m: integer);
90      function toString: string; override;      function toString: string; override;
91    end;    end;
92    
# Line 134  type Line 134  type
134    TCellV = class    TCellV = class
135    private    private
136      _cellG: TCellG;      _cellG: TCellG;
137      code: array [0..MAXCODE] of TInst;      code: array [0 .. MAXCODE] of TInst;
138      cIndex: integer;      cIndex: integer;
139      display, sdisplay: array [0..CellG.MaxLevel] of integer;      display, sdisplay: array [0 .. CellG.MaxLevel] of integer;
140    public    public
141      _cellK: TObject;      _cellK: TObject;
142      pCode, pTrace: Boolean;      pCode, pTrace: Boolean;
143      stack: array [0..MAXMEM] of integer;      stack: array [0 .. MAXMEM] of integer;
144      sstack: array [0..MAXMOJI] of string;      sstack: array [0 .. MAXMOJI] of string;
145      top: integer;      top: integer;
146      tos: integer;      tos: integer;
147      pc: integer;      pc: integer;
# Line 151  type Line 151  type
151      function genCodeT(const op, t: integer): integer;      function genCodeT(const op, t: integer): integer;
152      function genCodeA(const op: integer; a: TRaddr): integer;      function genCodeA(const op: integer; a: TRaddr): integer;
153      function genCodeV(const op, v: integer): integer;      function genCodeV(const op, v: integer): integer;
154      function genCodeP(op,v: integer): integer;      function genCodeP(op, v: integer): integer;
155      function genCodeS(op: integer; v: string): integer;      function genCodeS(op: integer; v: string): integer;
156      function genCodeO(const p: integer): integer;      function genCodeO(const p: integer): integer;
157      function genCodeC(l, c: integer): integer;      function genCodeC(l, c: integer): integer;
# Line 177  implementation Line 177  implementation
177  function codeName(const c: integer): string;  function codeName(const c: integer): string;
178  begin  begin
179    case c of    case c of
180    ict:      ict:
181          result:='ict';        result := 'ict';
182    ics:      ics:
183          result:='ics';        result := 'ics';
184    lit:      lit:
185          result:='lit';        result := 'lit';
186    lis:      lis:
187          result:='lis';        result := 'lis';
188    lod:      lod:
189          result:='lod';        result := 'lod';
190    los:      los:
191          result:='los';        result := 'los';
192    cal:      cal:
193          result:='cal';        result := 'cal';
194    ret:      ret:
195          result:='ret';        result := 'ret';
196    dit:      dit:
197          result:='dit';        result := 'dit';
198    dik:      dik:
199          result:='dik';        result := 'dik';
200    jmp:      jmp:
201          result:='jmp';        result := 'jmp';
202    jpc:      jpc:
203          result:='jpc';        result := 'jpc';
204    arr:      arr:
205          result:='arr';        result := 'arr';
206    adv:      adv:
207          result:='adv';        result := 'adv';
208    sto:      sto:
209          result:='sto';        result := 'sto';
210    opr:      opr:
211          result:='opr';        result := 'opr';
212    neg:      neg:
213          result:='neg';        result := 'neg';
214    _add:      _add:
215          result:='add';        result := 'add';
216    _sub:      _sub:
217          result:='sub';        result := 'sub';
218    _mul:      _mul:
219          result:='mul';        result := 'mul';
220    _div:      _div:
221          result:='div';        result := 'div';
222    eql:      eql:
223          result:='eql';        result := 'eql';
224    eqs:      eqs:
225          result:='eqs';        result := 'eqs';
226    neq:      neq:
227          result:='neq';        result := 'neq';
228    nes:      nes:
229          result:='nes';        result := 'nes';
230    lss:      lss:
231          result:='lss';        result := 'lss';
232    gtr:      gtr:
233          result:='gtr';        result := 'gtr';
234    leq:      leq:
235          result:='leq';        result := 'leq';
236    geq:      geq:
237          result:='geq';        result := 'geq';
238    prt:      prt:
239          result:='prt';        result := 'prt';
240    prs:      prs:
241          result:='prs';        result := 'prs';
242    prl:      prl:
243          result:='prl';        result := 'prl';
244    sid:      sid:
245          result:='sid';        result := 'sid';
246    sld:      sld:
247          result:='sld';        result := 'sld';
248    sls:      sls:
249          result:='sls';        result := 'sls';
250    lid:      lid:
251          result:='lid';        result := 'lid';
252    lda:      lda:
253          result:='lda';        result := 'lda';
254    las:      las:
255          result:='las';        result := 'las';
256    ini:      ini:
257          result:='ini';        result := 'ini';
258    _inc:      _inc:
259          result:='inc';        result := 'inc';
260    _dec:      _dec:
261          result:='dec';        result := 'dec';
262    lin:      lin:
263          result:='lin';        result := 'lin';
264    lde:      lde:
265          result:='lde';        result := 'lde';
266    ads:      ads:
267          result:='ads';        result := 'ads';
268    sus:      sus:
269          result:='sus';        result := 'sus';
270    stp:      stp:
271          result:='stp';        result := 'stp';
272    lds:      lds:
273          result:='lds';        result := 'lds';
274    sds:      sds:
275          result:='sds';        result := 'sds';
276    else    else
277          result:=inttostr(c);      result := inttostr(c);
278    end;    end;
279  end;  end;
280    
# Line 282  end; Line 282  end;
282    
283  constructor TInst.Create(const op: integer);  constructor TInst.Create(const op: integer);
284  begin  begin
285          inherited Create;    inherited Create;
286          opCode:=op;    opCode := op;
287  end;  end;
288    
289  function TInst.toString: string;  function TInst.toString: string;
290  begin  begin
291          result:=codeName(opCode);    result := codeName(opCode);
292  end;  end;
293    
294  { TCellV }  { TCellV }
# Line 297  procedure TCellV.backBreak(const c: inte Line 297  procedure TCellV.backBreak(const c: inte
297  var  var
298    bc, t: integer;    bc, t: integer;
299  begin  begin
300          bc:=c;    bc := c;
301    while bc <> 0 do    while bc <> 0 do
302    begin    begin
303          t:=(code[bc] as TInstPC).value;      t := (code[bc] as TInstPC).value;
304          (code[bc] as TInstPC).value:=cIndex+1;      (code[bc] as TInstPC).value := cIndex + 1;
305          bc:=t;      bc := t;
306    end;    end;
307  end;  end;
308    
309  procedure TCellV.backPatch(i, j: integer);  procedure TCellV.backPatch(i, j: integer);
310  begin  begin
311          (code[i] as TInstPC).value:=_cellG.numAddr;    (code[i] as TInstPC).value := _cellG.numAddr;
312          (code[j] as TInstPC).value:=_cellG.snumAddr;    (code[j] as TInstPC).value := _cellG.snumAddr;
313  end;  end;
314    
315  procedure TCellV.backPatchJ(const i: integer);  procedure TCellV.backPatchJ(const i: integer);
316  begin  begin
317          (code[i] as TInstPC).value:=cIndex+1;    (code[i] as TInstPC).value := cIndex + 1;
318  end;  end;
319    
320  procedure TCellV.backPatchL(i, j, a: integer);  procedure TCellV.backPatchL(i, j, a: integer);
321  begin  begin
322    if a = 0 then    if a = 0 then
323    begin      code[i].opCode := lda
324          code[i].opCode:=lda;    else
325    end else      code[i].opCode := las;
326    begin    (code[i] as TInstAddr).addr := _cellG.tAddr(j);
         code[i].opCode:=las;  
   end;  
         (code[i] as TInstAddr).addr:=_cellG.tAddr(j);  
327  end;  end;
328    
329  procedure TCellV.changeS(i, a: integer);  procedure TCellV.changeS(i, a: integer);
330  begin  begin
331    with code[i] as TInstOp do    with code[i] as TInstOp do
332    begin    begin
333    if a = 0 then      if a = 0 then
334    begin        if optr = sds then
335      if optr = sds then          optr := sid
336      begin        else
337          optr:=sid;          optr := sld
338      end else      else if optr = sid then
339      begin        optr := sds
340          optr:=sld;      else
341      end;        optr := sls;
   end else  
   begin  
     if optr = sid then  
     begin  
         optr:=sds;  
     end else  
     begin  
         optr:=sls;  
     end;  
   end;  
342    end;    end;
343  end;  end;
344    
345  procedure TCellV.checkMax;  procedure TCellV.checkMax;
346  begin  begin
347    if cIndex > MAXCODE then    if cIndex > MAXCODE then
348    begin      _cellG.error('コードオーバーです。')
349          _cellG.error('コードオーバーです。');    else
350    end else      inc(cIndex);
   begin  
         inc(cIndex);  
   end;  
351  end;  end;
352    
353  constructor TCellV.Create(g: TCellG; c, t: Boolean);  constructor TCellV.Create(g: TCellG; c, t: Boolean);
354  begin  begin
355          inherited Create;    inherited Create;
356          _cellG:=g;    _cellG := g;
357          pCode:=c;    pCode := c;
358          pTrace:=t;    pTrace := t;
359          cIndex:=-1;    cIndex := -1;
360          shokika;    shokika;
361  end;  end;
362    
363  destructor TCellV.Destroy;  destructor TCellV.Destroy;
364  begin  begin
365          shokika;    shokika;
366          inherited;    inherited;
367  end;  end;
368    
369  procedure TCellV.error;  procedure TCellV.error;
370  begin  begin
371          code[pc]:=TInstOp.Create(opr,stp);    code[pc] := TInstOp.Create(opr, stp);
372  end;  end;
373    
374  function TCellV.execute: integer;  function TCellV.execute: integer;
# Line 394  var Line 378  var
378    t: TInst;    t: TInst;
379    p: string;    p: string;
380  begin  begin
381          genCodeO(stp);    genCodeO(stp);
382    if _cellG.exe = 0 then    if _cellG.exe = 0 then
383    begin    begin
384          display[0]:=0;      display[0] := 0;
385          sdisplay[0]:=0;      sdisplay[0] := 0;
386    end;    end;
387          inc(_cellG.exe);    inc(_cellG.exe);
388    if pCode = true then    if pCode = true then
389    begin    begin
390          printCode;      printCode;
391          Writeln;      Writeln;
392    end;    end;
393    if pTrace = true then    if pTrace = true then
394    begin      Writeln('--- strat execution ---');
395          Writeln('--- strat execution ---');    temp := 0;
396    end;    tems := '';
397          temp:=0;    o1 := 0;
398          tems:='';    o2 := 0;
         o1:=0;  
         o2:=0;  
399    repeat    repeat
400      if pTrace = true then      if pTrace = true then
401      begin        printExe;
402          printExe;      t := code[pc];
403      end;      o1 := t.opCode;
         t:=code[pc];  
         o1:=t.opCode;  
404      case o1 of      case o1 of
405      ict:        ict:
     begin  
         inc(top,(t as TInstPC).value);  
       if top >= MAXMEM-MAXREG then  
       begin  
         Writeln('オーバーフローです。');  
         error;  
       end;  
     end;  
     lit:  
     begin  
         stack[top]:=(t as TInstVal).value;  
         inc(top);  
     end;  
     lod:  
     begin  
         stack[top]:=stack[display[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr];  
         inc(top);  
     end;  
     los:  
     begin  
         sstack[tos]:=sstack[sdisplay[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr];  
         inc(tos);  
     end;  
     ics:  
     begin  
         inc(tos,(t as TInstPC).value);  
       if tos >= MAXMEM-MAXMOJI then  
       begin  
                 Writeln('オーバーフローです。');  
                 error;  
       end;  
     end;  
     lis:  
     begin  
         sstack[tos]:=(t as TStrVal).value;  
         inc(tos);  
     end;  
     lda:  
     begin  
         stack[top]:=display[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr;  
         inc(top);  
     end;  
     las:  
     begin  
         stack[top]:=sdisplay[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr;  
         inc(top);  
     end;  
     sto:  
     begin  
         dec(top);  
         stack[display[TInstAddr(t).addr.level]+TInstAddr(t).addr.addr]:=stack[top];  
     end;  
     sts:  
     begin  
         dec(tos);  
         sstack[sdisplay[(t as TInstAddr).addr.level]+(t as TInstAddr).addr.addr]:=sstack[tos];  
     end;  
     cal:  
     begin  
         lev:=(t as TInstCal).level+1;  
         stack[top]:=display[lev];  
         stack[top+1]:=sdisplay[lev];  
         stack[top+2]:=pc+1;  
         display[lev]:=top;  
         sdisplay[lev]:=tos;  
         pc:=(t as TInstCal).code;  
         continue;  
     end;  
     ret:  
     begin  
         m:=(t as TInstRet).modori;  
       if m = CellG._I then  
       begin  
                 temp:=stack[top-1];  
       end else  
       begin  
                 tems:=sstack[tos-1];  
       end;  
         top:=display[(t as TInstRet).level];  
         tos:=sdisplay[(t as TInstRet).level];  
         display[(t as TInstRet).level]:=stack[top];  
         sdisplay[(t as TInstRet).level]:=stack[top+1];  
         pc:=stack[top+2];  
         dec(top,(t as TInstRet).pI);  
         dec(tos,(t as TInstRet).pS);  
       if m = CellG._I then  
       begin  
                 stack[top]:=temp;  
                 inc(top);  
       end else  
                 if m = CellG._S then  
       begin  
                 sstack[tos]:=tems;  
                 inc(tos);  
       end;  
         continue;  
     end;  
     dit:  
     begin  
         lev:=(t as TInstPC).value;  
         stack[top]:=display[lev];  
         stack[top+1]:=sdisplay[lev];  
         display[lev]:=top;  
         sdisplay[lev]:=tos;  
     end;  
     dik:  
     begin  
         lev:=(t as TInstPC).value;  
         top:=display[lev];  
         tos:=sdisplay[lev];  
         display[lev]:=stack[top];  
         sdisplay[lev]:=stack[top+1];  
     end;  
     jmp:  
     begin  
         pc:=(t as TInstPC).value;  
         continue;  
     end;  
     jpc:  
     begin  
         dec(top);  
       if stack[top] = 0 then  
       begin  
                 pc:=(t as TInstPC).value;  
                 continue;  
       end;  
     end;  
     arr:  
     begin  
         m:=stack[top-2];  
         m1:=stack[top-1];  
       if (m > TInstAddr(t).addr.level)or(m1 > TInstAddr(t).addr.addr) then  
       begin  
                 Writeln('配列オーバーです。');  
                 error;  
       end;  
         stack[top]:=TInstAddr(t).addr.level;  
         stack[top-2]:=m*stack[top];  
         stack[top-3]:=stack[top-3]+stack[top-2];  
         stack[top-3]:=stack[top-3]+m1;  
         dec(top,2);  
     end;  
     opr:  
     begin  
         o2:=TInstOp(t).optr;  
       case o2 of  
       neg:  
       begin  
                 stack[top-1]:=-stack[top-1];  
       end;  
       _add:  
       begin  
                 dec(top);  
                 stack[top-1]:=stack[top-1]+stack[top];  
       end;  
       _sub:  
       begin  
                 dec(top);  
                 stack[top-1]:=stack[top-1]-stack[top];  
       end;  
       _mul:  
       begin  
                 dec(top);  
                 stack[top-1]:=stack[top-1]*stack[top];  
       end;  
       _div:  
       begin  
                 dec(top);  
                 stack[top-1]:=stack[top-1] div stack[top];  
       end;  
       eql:  
       begin  
                 dec(top);  
         if stack[top-1] = stack[top] then  
         begin  
                 stack[top-1]:=1;  
         end else  
406          begin          begin
407                  stack[top-1]:=0;            inc(top, (t as TInstPC).value);
408          end;            if top >= MAXMEM - MAXREG then
409        end;            begin
410        neq:              Writeln('オーバーフローです。');
411        begin              error;
412                  dec(top);            end;
413          if stack[top-1] <> stack[top] then          end;
414          begin        lit:
415                  stack[top-1]:=1;          begin
416          end else            stack[top] := (t as TInstVal).value;
417          begin            inc(top);
418                  stack[top-1]:=0;          end;
419          end;        lod:
420        end;          begin
421        eqs:            stack[top] := stack[display[(t as TInstAddr).addr.level] +
422        begin              (t as TInstAddr).addr.addr];
423          if CompareText(sstack[tos-2],sstack[tos-1]) = 0 then            inc(top);
424          begin          end;
425                  stack[top]:=1;        los:
426          end else          begin
427          begin            sstack[tos] := sstack[sdisplay[(t as TInstAddr).addr.level] +
428                  stack[top]:=0;              (t as TInstAddr).addr.addr];
429          end;            inc(tos);
430            end;
431          ics:
432            begin
433              inc(tos, (t as TInstPC).value);
434              if tos >= MAXMEM - MAXMOJI then
435              begin
436                Writeln('オーバーフローです。');
437                error;
438              end;
439            end;
440          lis:
441            begin
442              sstack[tos] := (t as TStrVal).value;
443              inc(tos);
444            end;
445          lda:
446            begin
447              stack[top] := display[(t as TInstAddr).addr.level] + (t as TInstAddr)
448                .addr.addr;
449              inc(top);
450            end;
451          las:
452            begin
453              stack[top] := sdisplay[(t as TInstAddr).addr.level] + (t as TInstAddr)
454                .addr.addr;
455              inc(top);
456            end;
457          sto:
458            begin
459              dec(top);
460              stack[display[TInstAddr(t).addr.level] + TInstAddr(t).addr.addr] :=
461                stack[top];
462            end;
463          sts:
464            begin
465              dec(tos);
466              sstack[sdisplay[(t as TInstAddr).addr.level] + (t as TInstAddr)
467                .addr.addr] := sstack[tos];
468            end;
469          cal:
470            begin
471              lev := (t as TInstCal).level + 1;
472              stack[top] := display[lev];
473              stack[top + 1] := sdisplay[lev];
474              stack[top + 2] := pc + 1;
475              display[lev] := top;
476              sdisplay[lev] := tos;
477              pc := (t as TInstCal).code;
478              continue;
479            end;
480          ret:
481            begin
482              m := (t as TInstRet).modori;
483              if m = CellG._I then
484                temp := stack[top - 1]
485              else
486                tems := sstack[tos - 1];
487              top := display[(t as TInstRet).level];
488              tos := sdisplay[(t as TInstRet).level];
489              display[(t as TInstRet).level] := stack[top];
490              sdisplay[(t as TInstRet).level] := stack[top + 1];
491              pc := stack[top + 2];
492              dec(top, (t as TInstRet).pI);
493              dec(tos, (t as TInstRet).pS);
494              if m = CellG._I then
495              begin
496                stack[top] := temp;
497                inc(top);
498              end
499              else if m = CellG._S then
500              begin
501                sstack[tos] := tems;
502                inc(tos);
503              end;
504              continue;
505            end;
506          dit:
507            begin
508              lev := (t as TInstPC).value;
509              stack[top] := display[lev];
510              stack[top + 1] := sdisplay[lev];
511              display[lev] := top;
512              sdisplay[lev] := tos;
513            end;
514          dik:
515            begin
516              lev := (t as TInstPC).value;
517              top := display[lev];
518              tos := sdisplay[lev];
519              display[lev] := stack[top];
520              sdisplay[lev] := stack[top + 1];
521            end;
522          jmp:
523            begin
524              pc := (t as TInstPC).value;
525              continue;
526            end;
527          jpc:
528            begin
529              dec(top);
530              if stack[top] = 0 then
531              begin
532                pc := (t as TInstPC).value;
533                continue;
534              end;
535            end;
536          arr:
537            begin
538              m := stack[top - 2];
539              m1 := stack[top - 1];
540              if (m > TInstAddr(t).addr.level) or (m1 > TInstAddr(t).addr.addr) then
541              begin
542                Writeln('配列オーバーです。');
543                error;
544              end;
545              stack[top] := TInstAddr(t).addr.level;
546              stack[top - 2] := m * stack[top];
547              stack[top - 3] := stack[top - 3] + stack[top - 2];
548              stack[top - 3] := stack[top - 3] + m1;
549              dec(top, 2);
550            end;
551          opr:
552            begin
553              o2 := TInstOp(t).optr;
554              case o2 of
555                neg:
556                  stack[top - 1] := -stack[top - 1];
557                _add:
558                  begin
559                    dec(top);
560                    stack[top - 1] := stack[top - 1] + stack[top];
561                  end;
562                _sub:
563                  begin
564                    dec(top);
565                    stack[top - 1] := stack[top - 1] - stack[top];
566                  end;
567                _mul:
568                  begin
569                    dec(top);
570                    stack[top - 1] := stack[top - 1] * stack[top];
571                  end;
572                _div:
573                  begin
574                    dec(top);
575                    stack[top - 1] := stack[top - 1] div stack[top];
576                  end;
577                eql:
578                  begin
579                    dec(top);
580                    if stack[top - 1] = stack[top] then
581                      stack[top - 1] := 1
582                    else
583                      stack[top - 1] := 0;
584                  end;
585                neq:
586                  begin
587                    dec(top);
588                    if stack[top - 1] <> stack[top] then
589                      stack[top - 1] := 1
590                    else
591                      stack[top - 1] := 0;
592                  end;
593                eqs:
594                  begin
595                    if CompareText(sstack[tos - 2], sstack[tos - 1]) = 0 then
596                      stack[top] := 1
597                    else
598                      stack[top] := 0;
599                  inc(top);                  inc(top);
600                  dec(tos,2);                  dec(tos, 2);
601        end;                end;
602        nes:              nes:
603        begin                begin
604          if CompareText(sstack[tos-2],sstack[tos-1]) = 1 then                  if CompareText(sstack[tos - 2], sstack[tos - 1]) = 1 then
605          begin                    stack[top] := 1
606                  stack[top]:=1;                  else
607          end else                    stack[top] := 0;
         begin  
                 stack[top]:=0;  
         end;  
608                  inc(top);                  inc(top);
609                  dec(tos,2);                  dec(tos, 2);
610        end;                end;
611        lss:              lss:
612        begin                begin
613                  dec(top);                  dec(top);
614          if stack[top-1] < stack[top] then                  if stack[top - 1] < stack[top] then
615          begin                    stack[top - 1] := 1
616                  stack[top-1]:=1;                  else
617          end else                    stack[top - 1] := 0;
618          begin                end;
619                  stack[top-1]:=0;              gtr:
620          end;                begin
621        end;                  dec(top);
622        gtr:                  if stack[top - 1] > stack[top] then
623        begin                    stack[top - 1] := 1
624                  dec(top);                  else
625          if stack[top-1] > stack[top] then                    stack[top - 1] := 0;
626          begin                end;
627                  stack[top-1]:=1;              leq:
628          end else                begin
629          begin                  dec(top);
630                  stack[top-1]:=0;                  if stack[top - 1] <= stack[top] then
631          end;                    stack[top - 1] := 1
632        end;                  else
633        leq:                    stack[top - 1] := 0;
634        begin                end;
635                  dec(top);              geq:
636          if stack[top-1] <= stack[top] then                begin
637          begin                  dec(top);
638                  stack[top-1]:=1;                  if stack[top - 1] >= stack[top] then
639          end else                    stack[top - 1] := 1
640          begin                  else
641                  stack[top-1]:=0;                    stack[top - 1] := 0;
642          end;                end;
643        end;              prt:
644        geq:                begin
645        begin                  dec(top);
646                  dec(top);                  Writeln(inttostr(stack[top]));
647          if stack[top-1] >= stack[top] then                end;
648          begin              prs:
649                  stack[top-1]:=1;                begin
         end else  
         begin  
                 stack[top-1]:=0;  
         end;  
       end;  
       prt:  
       begin  
                 dec(top);  
                 Writeln(IntToStr(stack[top]));  
       end;  
       prs:  
       begin  
650                  dec(tos);                  dec(tos);
651                  Writeln(sstack[tos]);                  Writeln(sstack[tos]);
652        end;                end;
653        prl:              prl:
654                  Writeln;                Writeln;
655        ads:              ads:
656        begin                begin
657                  dec(tos);                  dec(tos);
658                  sstack[tos-1]:=sstack[tos-1]+sstack[tos];                  sstack[tos - 1] := sstack[tos - 1] + sstack[tos];
659        end;                end;
660        sus:              sus:
661        begin                begin
662                  dec(tos);                  dec(tos);
663                  s1:=sstack[tos-1];                  s1 := sstack[tos - 1];
664                  s2:=sstack[tos];                  s2 := sstack[tos];
665                  temp:=Pos(s2,s1);                  temp := Pos(s2, s1);
666          if temp > 0 then                  if temp > 0 then
667          begin                  begin
668                  Delete(s1,temp,Length(s2));                    Delete(s1, temp, Length(s2));
669                  sstack[tos-1]:=s1;                    sstack[tos - 1] := s1;
670          end;                  end;
671        end;                end;
672        mus:              mus:
673        begin                begin
674                  dec(top);                  dec(top);
675                  s1:='';                  s1 := '';
676                  s2:=sstack[tos-1];                  s2 := sstack[tos - 1];
677          for m:=1 to stack[top] do                  for m := 1 to stack[top] do
678          begin                    s1 := s1 + s2;
679                  s1:=s1+s2;                  sstack[tos - 1] := s1;
680          end;                end;
681                  sstack[tos-1]:=s1;              dis:
682        end;                begin
683        dis:                  s1 := sstack[tos - 3];
684        begin                  s2 := sstack[tos - 2];
685                  s1:=sstack[tos-3];                  m := Pos(s2, s1);
686                  s2:=sstack[tos-2];                  while m > 0 do
687                  m:=Pos(s2,s1);                  begin
688          while m > 0 do                    Delete(s1, m, Length(s2));
689          begin                    Insert(sstack[tos - 1], s1, m);
690                  Delete(s1,m,Length(s2));                    m := Pos(s2, s1);
691                  Insert(sstack[tos-1],s1,m);                  end;
692                  m:=Pos(s2,s1);                  sstack[tos - 3] := s1;
693          end;                  dec(tos, 2);
694                  sstack[tos-3]:=s1;                end;
695                  dec(tos,2);              ini:
696        end;                begin
697        ini:                  p := '';
698        begin                  while _cellG.checkIn(p) = true do
699                  p:='';                  begin
700          while _cellG.checkIn(p) = true do                    Writeln('数字を入力してください。');
701          begin                    Write('>');
702                  Writeln('数字を入力してください。');                    Readln(p);
703                  Write('>');                  end;
704                  Readln(p);                  stack[top] := StrToInt(p);
         end;  
                 stack[top]:=StrToInt(p);  
705                  inc(top);                  inc(top);
706        end;                end;
707        ins:              ins:
708        begin                begin
709                  p:='';                  p := '';
710                  Write('>');                  Write('>');
711                  Readln(p);                  Readln(p);
712                  sstack[tos]:=p;                  sstack[tos] := p;
713                  inc(tos);                  inc(tos);
714        end;                end;
715        sid:              sid:
716        begin                begin
717                  stack[stack[top-2]]:=stack[top-1];                  stack[stack[top - 2]] := stack[top - 1];
718                  dec(top,2);                  dec(top, 2);
719        end;                end;
720        lid:              lid:
721                  stack[top-1]:=stack[stack[top-1]]; //                stack[top - 1] := stack[stack[top - 1]]; //
722        lds:              lds:
723        begin                begin
724                  dec(top);                  dec(top);
725                  sstack[tos]:=sstack[stack[top]];                  sstack[tos] := sstack[stack[top]];
726                  inc(tos);                  inc(tos);
727        end;                end;
728        sld:              sld:
729        begin                begin
730                  dec(top);                  dec(top);
731                  stack[stack[top-1]]:=stack[top];                  stack[stack[top - 1]] := stack[top];
732                  stack[top-1]:=stack[top];                  stack[top - 1] := stack[top];
733        end;                end;
734        sls:              sls:
735        begin                begin
736                  dec(top);                  dec(top);
737                  sstack[stack[top]]:=sstack[tos-1];                  sstack[stack[top]] := sstack[tos - 1];
738        end;                end;
739        sds:              sds:
740        begin                begin
741                  dec(top);                  dec(top);
742                  dec(tos);                  dec(tos);
743                  sstack[stack[top]]:=sstack[tos];                  sstack[stack[top]] := sstack[tos];
744        end;                end;
745        _inc:              _inc:
746        begin                begin
747                  dec(top);                  dec(top);
748                  inc(stack[top]);                  inc(stack[top]);
749        end;                end;
750        _dec:              _dec:
751        begin                begin
752                  dec(top);                  dec(top);
753                  dec(stack[top]);                  dec(stack[top]);
754        end;                end;
755        lin,lde:              lin, lde:
756        begin                begin
757                  m:=stack[top-1];                  m := stack[top - 1];
758          if o2 =lin then                  if o2 = lin then
759          begin                    inc(stack[m])
760                  inc(stack[m]);                  else
761          end else                    dec(stack[m]);
762          begin                  stack[top - 1] := stack[m];
763                  dec(stack[m]);                end;
764              end;
765          end;          end;
                 stack[top-1]:=stack[m];  
       end;  
       end;  
     end;  
766      end;      end;
767          inc(pc);      inc(pc);
768    until o2 = stp;    until o2 = stp;
769          shokika;    shokika;
770          _cellG.shokika;    _cellG.shokika;
771          _cellG.closeFile;    _cellG.closeFile;
772          pTrace:=false;    pTrace := false;
773          pCode:=false;    pCode := false;
774          _cellG.pTable:=false;    _cellG.pTable := false;
775  end;  end;
776    
777  function TCellV.genCodeA(const op: integer; a: TRaddr): integer;  function TCellV.genCodeA(const op: integer; a: TRaddr): integer;
778  begin  begin
779          checkMax;    checkMax;
780          code[cIndex]:=TInstAddr.Create(op,a);    code[cIndex] := TInstAddr.Create(op, a);
781          result:=cIndex;    result := cIndex;
782  end;  end;
783    
784  function TCellV.genCodeC(l, c: integer): integer;  function TCellV.genCodeC(l, c: integer): integer;
785  begin  begin
786          checkMax;    checkMax;
787          code[cIndex]:=TInstCal.Create(cal,l,c);    code[cIndex] := TInstCal.Create(cal, l, c);
788          result:=cIndex;    result := cIndex;
789  end;  end;
790    
791  function TCellV.genCodeO(const p: integer): integer;  function TCellV.genCodeO(const p: integer): integer;
792  begin  begin
793          checkMax;    checkMax;
794          code[cIndex]:=TInstOp.Create(opr,p);    code[cIndex] := TInstOp.Create(opr, p);
795          result:=cIndex;    result := cIndex;
796  end;  end;
797    
798  function TCellV.genCodeR: integer;  function TCellV.genCodeR: integer;
799  begin  begin
800    if code[cIndex].opCode = ret then    if code[cIndex].opCode = ret then
801    begin    begin
802          result:=cIndex;      result := cIndex;
803          Exit;      Exit;
804    end;    end;
805          checkMax;    checkMax;
806          code[cIndex]:=TInstRet.Create(ret,_cellG.bLevel,_cellG.funcParIs,_cellG.funcParSs,_cellG.funcModori);    code[cIndex] := TInstRet.Create(ret, _cellG.bLevel, _cellG.funcParIs,
807          result:=cIndex;      _cellG.funcParSs, _cellG.funcModori);
808      result := cIndex;
809  end;  end;
810    
811  function TCellV.genCodeS(op: integer; v: string): integer;  function TCellV.genCodeS(op: integer; v: string): integer;
812  begin  begin
813          checkMax;    checkMax;
814          code[cIndex]:=TStrVal.Create(op,v);    code[cIndex] := TStrVal.Create(op, v);
815          result:=cIndex;    result := cIndex;
816  end;  end;
817    
818  function TCellV.genCodeT(const op, t: integer): integer;  function TCellV.genCodeT(const op, t: integer): integer;
819  begin  begin
820          checkMax;    checkMax;
821          code[cIndex]:=TInstAddr.Create(op,_cellG.tAddr(t));    code[cIndex] := TInstAddr.Create(op, _cellG.tAddr(t));
822          result:=cIndex;    result := cIndex;
823  end;  end;
824    
825  function TCellV.genCodeV(const op, v: integer): integer;  function TCellV.genCodeV(const op, v: integer): integer;
826  begin  begin
827          checkMax;    checkMax;
828          code[cIndex]:=TInstVal.Create(op,v);    code[cIndex] := TInstVal.Create(op, v);
829          result:=cIndex;    result := cIndex;
830  end;  end;
831    
832  function TCellV.nextCode: integer;  function TCellV.nextCode: integer;
833  begin  begin
834          result:=cIndex+1;    result := cIndex + 1;
835  end;  end;
836    
837  procedure TCellV.printCode;  procedure TCellV.printCode;
838  var  var
839    i: integer;    i: integer;
840  begin  begin
841          Writeln('--- code ---');    Writeln('--- code ---');
842    for i:=0 to cIndex do    for i := 0 to cIndex do
843    begin      Writeln(inttostr(i) + ' : ' + code[i].toString);
         Writeln(IntToStr(i)+' : '+code[i].toString);  
   end;  
844  end;  end;
845    
846  procedure TCellV.printExe;  procedure TCellV.printExe;
847  begin  begin
848    if o1 = 0 then    if o1 = 0 then
849        Exit
850      else if o1 = -1 then
851    begin    begin
852          Exit;      Writeln;
853    end else      Exit;
854          if o1 = -1 then    end
855    begin    else if o1 <> opr then
856          Writeln;      Write(codeName(o1) + ' : ');
         Exit;  
   end else  
         if o1 <> opr then  
   begin  
         Write(codeName(o1)+' : ');  
   end;  
857    case o1 of    case o1 of
858    ict:      ict:
859          Writeln('Istack='+IntToStr(top));        Writeln('Istack=' + inttostr(top));
860    ics:      ics:
861          Writeln('Sstack='+IntToStr(tos));        Writeln('Sstack=' + inttostr(tos));
862    lit,lod,lda,las,arr:      lit, lod, lda, las, arr:
863          Writeln('Istack='+IntToStr(top-1)+' : '+IntToStr(stack[top-1]));        Writeln('Istack=' + inttostr(top - 1) + ' : ' + inttostr(stack[top - 1]));
864    lis,los,lds:      lis, los, lds:
865          Writeln('Sstack='+IntToStr(tos-1)+' : '+sstack[tos-1]);        Writeln('Sstack=' + inttostr(tos - 1) + ' : ' + sstack[tos - 1]);
866    sto:      sto:
867          Writeln(IntToStr(stack[top]));        Writeln(inttostr(stack[top]));
868    ret,jmp,jpc:      ret, jmp, jpc:
869          Writeln(IntToStr(pc));        Writeln(inttostr(pc));
870    cal:      cal:
871          Writeln(IntToStr(pc));        Writeln(inttostr(pc));
872    dit,dik:      dit, dik:
873          Writeln;        Writeln;
874    opr:      opr:
875    begin        begin
876          Write(codeName(o2)+' : ');          Write(codeName(o2) + ' : ');
877      if o2 < ini then          if o2 < ini then
878      begin            Writeln('Istack=' + inttostr(top - 1) + ' : ' +
879          Writeln('Istack='+IntToStr(top-1)+' : '+IntToStr(stack[top-1]));              inttostr(stack[top - 1]))
880      end else          else if o2 < prt then
881          if o2 < prt then            Writeln(inttostr(stack[top]))
882      begin          else
883          Writeln(IntToStr(stack[top]));            Writeln(sstack[tos]);
884      end else        end;
     begin  
         Writeln(sstack[tos]);  
     end;  
   end;  
885    else    else
886          Writeln(IntToStr(o1));      Writeln(inttostr(o1));
887    end;    end;
888  end;  end;
889    
890  procedure TCellV.backCal(i, l, c: integer);  procedure TCellV.backCal(i, l, c: integer);
891  begin  begin
892          (code[i] as TInstCal).code:=c;    (code[i] as TInstCal).code := c;
893          (code[i] as TInstCal).level:=l;    (code[i] as TInstCal).level := l;
894  end;  end;
895    
896  procedure TCellV.shokika;  procedure TCellV.shokika;
897  var  var
898    i: integer;    i: integer;
899  begin  begin
900    for i:=0 to cIndex do    for i := 0 to cIndex do
901    begin      code[i].Free;
902          code[i].Free;    cIndex := -1;
903    end;    top := 0;
904          cIndex:=-1;    tos := 0;
905          top:=0;    pc := 0;
         tos:=0;  
         pc:=0;  
906  end;  end;
907    
908  function TCellV.genCodeP(op, v: integer): integer;  function TCellV.genCodeP(op, v: integer): integer;
909  begin  begin
910          checkMax;    checkMax;
911          code[cIndex]:=TInstPC.Create(op,v);    code[cIndex] := TInstPC.Create(op, v);
912          result:=cIndex;    result := cIndex;
913  end;  end;
914    
915  function TCellV.genCodeRV: integer;  function TCellV.genCodeRV: integer;
916  begin  begin
917    if code[cIndex].opCode = ret then    if code[cIndex].opCode = ret then
918    begin    begin
919          result:=cIndex;      result := cIndex;
920          Exit;      Exit;
921    end;    end;
922          checkMax;    checkMax;
923          code[cIndex]:=TInstRet.Create(ret,_cellG.bLevel+1,_cellG.funcParIs,_cellG.funcParSs,_cellG.funcModori);    code[cIndex] := TInstRet.Create(ret, _cellG.bLevel + 1, _cellG.funcParIs,
924          result:=cIndex;      _cellG.funcParSs, _cellG.funcModori);
925      result := cIndex;
926  end;  end;
927    
928  { TInstAddr }  { TInstAddr }
929    
930  constructor TInstAddr.Create(const op: integer; a: TRaddr);  constructor TInstAddr.Create(const op: integer; a: TRaddr);
931  begin  begin
932          inherited Create(op);    inherited Create(op);
933          addr:=a;    addr := a;
934  end;  end;
935    
936  function TInstAddr.toString: string;  function TInstAddr.toString: string;
937  begin  begin
938          result:=inherited toString+',addr='+IntToStr(addr.level)+IntToStr(addr.addr);    result := inherited toString + ',addr=' + inttostr(addr.level) +
939        inttostr(addr.addr);
940  end;  end;
941    
942  { TInstRet }  { TInstRet }
943    
944  constructor TInstRet.Create(const op, l, pi, ps, m: integer);  constructor TInstRet.Create(const op, l, pI, pS, m: integer);
945  begin  begin
946          inherited Create(op);    inherited Create(op);
947          level:=l;    level := l;
948          self.pI:=pi;    self.pI := pI;
949          self.pS:=ps;    self.pS := pS;
950          modori:=m;    modori := m;
951  end;  end;
952    
953  function TInstRet.toString: string;  function TInstRet.toString: string;
954  begin  begin
955          result:=inherited toString+',level='+IntToStr(level)+',pI='+    result := inherited toString + ',level=' + inttostr(level) + ',pI=' +
956                  IntToStr(pI)+',modori='+cellG.hyouji(modori);      inttostr(pI) + ',modori=' + CellG.hyouji(modori);
957  end;  end;
958    
959  { TInstVal }  { TInstVal }
960    
961  constructor TInstVal.Create(const op, v: integer);  constructor TInstVal.Create(const op, v: integer);
962  begin  begin
963          inherited Create(op);    inherited Create(op);
964          value:=v;    value := v;
965  end;  end;
966    
967  function TInstVal.toString: string;  function TInstVal.toString: string;
968  begin  begin
969          result:=inherited toString+',value='+IntToStr(value);    result := inherited toString + ',value=' + inttostr(value);
970  end;  end;
971    
972  { TInstOp }  { TInstOp }
973    
974  constructor TInstOp.Create(const op, o: integer);  constructor TInstOp.Create(const op, o: integer);
975  begin  begin
976          inherited Create(op);    inherited Create(op);
977          optr:=o;    optr := o;
978  end;  end;
979    
980  function TInstOp.toString: string;  function TInstOp.toString: string;
981  begin  begin
982          result:=inherited toString+',optr='+codeName(optr);    result := inherited toString + ',optr=' + codeName(optr);
983  end;  end;
984    
985  { TStrVal }  { TStrVal }
986    
987  constructor TStrVal.Create(op: integer; v: string);  constructor TStrVal.Create(op: integer; v: string);
988  begin  begin
989          inherited Create(op);    inherited Create(op);
990          value:=v;    value := v;
991  end;  end;
992    
993  function TStrVal.toString: string;  function TStrVal.toString: string;
994  begin  begin
995          result:=(inherited toString)+'.value='+value;    result := (inherited toString) + '.value=' + value;
996  end;  end;
997    
998  { TInstCal }  { TInstCal }
999    
1000  constructor TInstCal.Create(op, l, c: integer);  constructor TInstCal.Create(op, l, c: integer);
1001  begin  begin
1002          inherited Create(op);    inherited Create(op);
1003          level:=l;    level := l;
1004          code:=c;    code := c;
1005  end;  end;
1006    
1007  function TInstCal.toString: string;  function TInstCal.toString: string;
1008  begin  begin
1009          result:=(inherited toString)+','+IntToStr(code);    result := (inherited toString) + ',' + inttostr(code);
1010  end;  end;
1011    
1012  { TInstPC }  { TInstPC }
1013    
1014  constructor TInstPC.Create(op, v: integer);  constructor TInstPC.Create(op, v: integer);
1015  begin  begin
1016          inherited Create(op);    inherited Create(op);
1017          value:=v;    value := v;
1018  end;  end;
1019    
1020  function TInstPC.toString: string;  function TInstPC.toString: string;
1021  begin  begin
1022          result:=(inherited toString)+'.value'+IntToStr(value);    result := (inherited toString) + '.value' + inttostr(value);
1023  end;  end;
1024    
1025  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