pl0.pas

pl0的几个小程序 老师给的 很简单 共享下

                 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);
                        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);
                      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*)

         procedure interpret;
           const stacksize=500;
           var p,b,t:integer;
               i:instruction;
               s:array[1..stacksize] of integer;
           function base(l:integer):integer;
             var b1:integer;
               begin
                 b1:=b;
                 while l>0 do
                 begin
                   b1:=s[b1];
                   l:=l-1
                 end;
               base:=b1
             end;(*base*)

         begin
         
          writeln('start pl0');
          writeln(fa1,'start pl0'); writeln(fa2,'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 (*operate*)
                      0: begin
                           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]:8);
                           writeln(fa2,s[t]:8);  writeln(fa1,s[t]:8);
                           t:=t-1
                         end;
                     15: begin
                           writeln;
                           writeln(fa2); writeln(fa1)
                         end;
                     16: begin
                           t:=t+1;
                           write('?');
                           write(fa2,'?');  write(fa1,'?');
                           readln(s[t]);
                           writeln(fa2,s[t]);  writeln(fa1,s[t])
                         end
                     end;
                lod: begin
                       t:=t+1;
                       s[t]:=s[base(l)+a]
                     end;
                sto: begin
                       s[base(l)+a]:=s[t];
                       t:=t-1
                     end;
                cal: begin
                        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; writeln(fa2,'End pl0.');
             close(fa2)
           end(*interpret*);

           begin (*main*)
            for ch:=' ' to '!' do ssym[ch]:=nul;
            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[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];
    facbegsys:=[ident,number,lparen];

  
    write('input file name(PL/0 program file) ?    ');
    readln(fname); fnamefa1:=fname;
    assign(fin,fname);
    Reset(fin);
    write('please input a outputfile name :'); readln(fname);
    assign(fa1,fname);
    rewrite(fa1);
    write(fa1,'input file name(PL/0 program file)?   ');
    writeln(fa1,fnamefa1);
    write('list object code  ?');
    readln(fname);
    write(fa1,'list object code  ?'); writeln(fa1,fname);
    listswitch:=(fname[1]='y');
    err:=0;
    cc:=0; cx:=0; ll:=0;
    ch:=' '; kk:=al;
    getsym;
    assign(fa,'fa');     rewrite(fa);
    assign(fa2,'fa2.txt');   rewrite(fa2);
    block(0,0,[period]+declbegsys+statbegsys);
    close(fa);
   
    if sym<> period
     then error(9);
    if err=0
      then
       begin
        for ll:=0 to cx-1 do
            with code[ll] do writeln(fa2,ll:4,'  ',mnemonic[f]:5,l:3,a:5);
        interpret
       end
      else write('errors in pl/0 program');

  99:
    close(fin);  close(fa1);
    writeln
end.