pl0.dpr

数据结构中编译器的算法

                           num:=0; 
                        end; 
                        gen(lit,0,num);
                        getsym;
                    end else if sym=lparen then begin
                        getsym;
                        expression([rparen]+fsys); 
                        if sym=rparen then getsym 
                        else error(22); 
                    end; 
                    test(fsys,facbegsys,23); 
                  end; 
                end; (* factor *) 
  
            begin (* term *) 
              factor([times,slash]+fsys);
              while sym in [times,slash] do begin
                mulop:=sym; 
                getsym; 
                factor(fsys+[times,slash]); 
                if mulop=times then gen(opr,0,4) else gen(opr,0,5) 
              end;
            end; (* term *) 

        begin (* expression *) 
          if sym in [plus,minus] then begin
             addop:=sym; 
             getsym; 
             term(fsys+[plus,minus]);
             if addop=minus then gen(opr,0,1);
          end else term(fsys+[plus,minus]); 
          while sym in [plus,minus] do begin 
            addop:=sym; 
            getsym; 
            term(fsys+[plus,minus]); 
            if addop=plus then gen(opr,0,2) else gen(opr,0,3);
          end; 
        end; (* expression *) 
  
        procedure condition(fsys:symset); 
        var relop:symbol; 
        begin
          if sym=oddsym then begin 
             getsym; 
             expression(fsys);
             gen(opr,0,6); 
          end else begin 
             expression([eql,neq,lss,leq,gtr,geq]+fsys);
             if not(sym in [eql,neq,lss,leq,gtr,geq]) then error(20) 
             else begin 
               relop:=sym;
               getsym; 
               expression(fsys); 
               case relop of
                 eql:gen(opr,0,8);
                 neq:gen(opr,0,9); 
                 lss:gen(opr,0,10);
                 geq:gen(opr,0,11); 
                 gtr:gen(opr,0,12); 
                 leq:gen(opr,0,13);
               end; 
             end; 
          end; 
        end; (* condition *) 
  
    begin (* statement *)
      if sym=ident then begin
         i:=position(id); 
         if i=0 then error(11)
         else if table[i].kind<>variable then begin
           error(12); 
           i:=0; 
         end; 
         getsym;
         if sym=becomes then getsym else error(13); 
         expression(fsys); 
         if i<>0 then with table[i] do gen(sto,lev-level,adr); 
      end else if sym=readsym then begin 
         getsym; 
         if sym<>lparen then error(34) 
         else repeat
                getsym; 
                if sym=ident then i:=position(id) 
                else i:=0; 
                if i=0 then error(35) 
                else with table[i] do begin
                  gen(opr,0,16); 
                  gen(sto,lev-level,adr);
                end; 
                getsym; 
         until sym<>comma;
         if sym<>rparen then begin 
            error(33); 
            while not(sym in fsys) do getsym; 
         end else getsym; 
      end else if sym=writesym then begin
         getsym; 
         if sym=lparen then begin
            repeat 
              getsym;
              expression([rparen,comma]+fsys);
              gen(opr,0,14);
            until sym<>comma; 
            if sym<>rparen then error(33) else getsym; 
         end; 
         gen(opr,0,15); 
      end else if sym=callsym then begin 
         getsym; 
         if sym<>ident then error(14) 
         else begin 
           i:=position(id);
           if i=0 then error(11) else with table[i] do 
              if kind=procedur then gen(cal,lev-level,adr) 
              else error(15); 
           getsym; 
         end; 
      end else if sym=ifsym then begin
         getsym; 
         condition([thensym,dosym]+fsys);
         if sym=thensym then getsym 
         else error(16); 
         cx1:=cx;
         gen(jpc,0,0);
         statement(fsys); 
         code[cx1].a:=cx; 
      end else if sym=beginsym then begin
         getsym; 
         statement([semicolon,endsym]+fsys); 
         while sym in [semicolon]+statbegsys do begin
           if sym=semicolon then getsym 
           else error(10); 
           statement([semicolon,endsym]+fsys);
         end; 
         if sym=endsym then getsym else error(17);
      end else if sym=whilesym then begin 
         cx1:=cx; 
         getsym; 
         condition([dosym]+fsys);
         cx2:=cx; 
         gen(jpc,0,0); 
         if sym=dosym then getsym else error(18); 
         statement(fsys); 
         gen(jmp,0,cx1); 
         code[cx2].a:=cx; 
      end; 
      test(fsys,[],19); 
    end; (* statement *) 

begin (* block *) 
  dx:=3; (*Page23*)
  tx0:=tx; 
  table[tx].adr:=cx;(*暂时保留下标指针cx在table表中 *)
  gen(jmp,0,0);
  if lev>levmax then error(32); 
  repeat 
    if sym=constsym then begin 
       getsym; 
       repeat 
         constdeclaration; 
         while sym=comma do begin
           getsym; 
           constdeclaration; 
         end;
         if sym=semicolon then getsym else error(5); 
       until sym<>ident; 
    end; 
    if sym=varsym then begin 
       getsym; 
       repeat; 
         vardeclaration; 
         while sym=comma do begin 
           getsym; 
           vardeclaration; 
         end; 
         if sym=semicolon then getsym else error(5); 
       until sym<>ident; 
    end; 
    while sym=procsym do begin
      getsym;
      if sym=ident then begin 
         enter(procedur);
         getsym; 
      end else error(4); 
      if sym=semicolon then getsym else error(5);
      block(lev+1,tx,[semicolon]+fsys); (*递归调用block *)
      if sym=semicolon then begin 
         getsym; 
         test(statbegsys+[ident,procsym],fsys,6); 
      end else error(5); 
    end; 
    test(statbegsys+[ident],declbegsys,7);
  until not(sym in declbegsys);  (*repeat*)

  code[table[tx0].adr].a:=cx;
  with table[tx0] do begin 
       adr:=cx; 
       size:=dx; 
  end; 
  cx0:=cx; 
  gen(int,0,dx); 
  statement([semicolon,endsym]+fsys); 
  gen(opr,0,0);
  test(fsys,[],8);
  listcode; 
end; (* block *)

(*解释执行目标代码 code[] *)
procedure interpret; 
const stacksize=500; 
var p,b,t:integer; (* program base topstack registers *) 
    i:instruction; 
    s:array[1..stacksize] of integer; (* datastore *)
  
    function base(l:integer):integer;
    var bl:integer; 
    begin 
      bl:=b; (* find base 1 level down *)
      while l>0 do begin 
        bl:=s[bl]; 
        l:=l-1; 
      end; 
      base:=bl; 
    end; (* base *) 

begin
  writeln('start pl0'); 
  t:=0; b:=1; p:=0; 
  s[1]:=0; s[2]:=0; s[3]:=0; 
  repeat 
    i:=code[p]; 
    p:=p+1; 
    with i do case f of
      lit: begin t:=t+1; s[t]:=a; end; 
      opr: case a of (* operator *) 
             0: begin (* return *)
                  t:=b-1; 
                  p:=s[t+3]; 
                  b:=s[t+2];
                end; 
             1: s[t]:=-s[t]; 
             2: begin t:=t-1; s[t]:=s[t]+s[t+1]; end; 
             3: begin t:=t-1; s[t]:=s[t]-s[t+1]; end; 
             4: begin t:=t-1; s[t]:=s[t]*s[t+1]; end;
             5: begin t:=t-1; s[t]:=s[t] div s[t+1]; end; 
             6: s[t]:=ord(odd(s[t]));
             8: begin t:=t-1; s[t]:=ord(s[t]=s[t+1]); end; 
             9: begin t:=t-1; s[t]:=ord(s[t]<>s[t+1]); end; 
             10:begin t:=t-1; s[t]:=ord(s[t]<s[t+1]); end;
             11:begin t:=t-1; s[t]:=ord(s[t]>=s[t+1]); end; 
             12:begin t:=t-1; s[t]:=ord(s[t]>s[t+1]); end; 
             13:begin t:=t-1; s[t]:=ord(s[t]<=s[t+1]); end; 
             14:begin write(s[t]); write(fa2,s[t]); t:=t-1; end;
             15:begin writeln; writeln(fa2); end;
             16:begin t:=t+1; write('?'); write(fa2,'?'); readln(s[t]);
                writeln(fa2,s[t]); end;
           end;
      lod: begin t:=t+1; s[t]:=s[base(l)+a]; end; 
      sto: begin s[base(l)+a]:=s[t]; (* writeln(s[t]) *) t:=t-1; end;
      cal: begin (* generat new block mark *) s[t+1]:=base(l); s[t+2]:=b; 
           s[t+3]:=p; b:=t+1; p:=a; end; 
      int: t:=t+a; 
      jmp: p:=a; 
      jpc: begin if s[t]=0 then p:=a; t:=t-1; end; 
    end; (* with, case *)
  until p=0; 
  close(fa2);
end; (* interpret *) 
  
begin (* main *)
  for ch:=' ' to '!' do ssym[ch]:=nul; 
  (* changed bacause of different character set
     note the typos below in the original where 
     the alfas were not given the correct space *) 
  (*word[]一定要按字母升序排列，因为在GetSym中要用折半查找法查找 *)
  word[1]:='begin     ';  word[2]:='call      ';
  word[3]:='const     ';  word[4]:='do        ';
  word[5]:='end       ';  word[6]:='if        ';
  word[7]:='odd       ';  word[8]:='procedure ';
  word[9]:='read      ';  word[10]:='then      ';
  word[11]:='var       '; word[12]:='while     ';
  word[13]:='write     ';
  (*wsym是word symbol,关键字纯量类型，word是字符串类型 *)
  wsym[1]:=beginsym;   wsym[2]:=callsym;
  wsym[3]:=constsym;   wsym[4]:=dosym; 
  wsym[5]:=endsym;     wsym[6]:=ifsym; 
  wsym[7]:=oddsym;     wsym[8]:=procsym;
  wsym[9]:=readsym;    wsym[10]:=thensym; 
  wsym[11]:=varsym;    wsym[12]:=whilesym; 
  wsym[13]:=writesym; 

  ssym['+']:=plus;     ssym['-']:=minus;
  ssym['*']:=times;    ssym['/']:=slash;
  ssym['(']:=lparen;   ssym[')']:=rparen;
  ssym['=']:=eql;      ssym[',']:=comma;
  ssym['.']:=period;   ssym['#']:=neq;
  ssym[';']:=semicolon;
  
  mnemonic[lit]:='lit  ';  mnemonic[opr]:='opr  '; 
  mnemonic[lod]:='lod  ';  mnemonic[sto]:='sto  '; 
  mnemonic[cal]:='cal  ';  mnemonic[int]:='int  '; 
  mnemonic[jmp]:='jmp  ';  mnemonic[jpc]:='jpc  '; 
  
  declbegsys:=[constsym,varsym,procsym]; 
  statbegsys:=[beginsym,callsym,ifsym,whilesym,writesym,readsym]; 
  facbegsys:=[ident,number,lparen];(*Page15 标识符，数字，左括号*)

  (* page(output) *)
  endf:=false; 
  assign(fa1,'PL0.txt');  (*打开'PL0.txt'写 *)
  rewrite(fa1);
  write('input file? '); 
  write(fa1,'input file?');
  fname:='test.txt';
(*  readln(fname);*)
  writeln(fa1,fname);
  (* openf(fin,fname,'r'); ==> *)
  assign(fin,fname); reset(fin); (*打开源文件读 *)
  write('list object code ?');
(*  readln(fname);  现在用fname保存用户的回答Y/N *)
fname[1]:='y';
  write(fa1,'list object code ?');
  listswitch:=(fname[1]='y');
  err:=0;
  cc:=0; cx:=0; ll:=0;
  ch:=' '; kk:=al; (*kk暂存标识符的最大长度*)
  getsym;
  assign(fa,'PL0-1.txt'); 
  assign(fa2,'PL0-2.txt');
  rewrite(fa);
  rewrite(fa2);
  block(0,0,[period]+declbegsys+statbegsys);
  close(fa);
  close(fa1);
  if sym<>period then error(9);
  if err=0 then interpret else write('error in pl/0 program');
99: (* this line is not work in turbo pascal so replace by
       procedure exitp: see the memo at the top *) 
  close(fin);
  readln;
end.