pl0语言编译程序分析(pascall版).txt

PL/0语言编译程序分析(pascal版)

      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,gtr,leq,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 (*assignment to non-variable*)
          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 = 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 = prozedure 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;
  tx0:= tx;
  table[tx].adr:= cx;
  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(prozedure);
        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; (*start adr of code*)
  end;
  cx0:= cx;
  gen(int,0,dx);
  statement([semicolon,endsym]+fsys);
  gen(opr,0,0); (*return*)
  test(fsys,[],8);
  listcode;
end (*block*);

procedure interpret;
const
  stacksize = 500;
var 
  p,b,t: integer; (*program-,base-,topstack-registers*)
  i: instruction; (*instruction register*)
  s: array[1..stacksize] of integer;  (*datastore*)

  function base(l: integer): integer;
  var
    b1: integer;
  begin
    b1:= b;(*find base l levels down*)
    while l>0 do (*??*)
    begin
      b1:= s[b1];
      l:= l-1
    end;
    base:= b1
  end (*base*);

begin
  writeln('Start PL/0');
  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;
         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 (*generate 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;
  write('End PL/0');
end (*interpret*);

begin (*main program*)
  for ch:= 'A' 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]:= 'then      ';
  word[10]:= 'var       ';
  word[11]:= 'while     ';
  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]:= thensym;    wsym[10]:= varsym;
  wsym[11]:= whilesym;
  ssym['+']:= plus;
  ssym['-']:= minus;
  ssym['*']:= times;
  ssym['/']:= slash;
  ssym['(']:= lparen;
  ssym[')']:= rparen;
  ssym['=']:= eql;
  ssym[',']:= comma;
  ssym['.']:= period;
  ssym['#']:= neq;
  ssym['<']:= lss;
  ssym['>']:= gtr;
  ssym[';']:= leq;
  ssym[';']:= geq;
  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];
  page(output);
  err:= 0;
  cc:= 0;
  cx:= 0;
  ll:= 0;
  ch:= ' ';
  kk:= al;
  getsym;
  block(0,0,[period]+declbegsys+statbegsys);
  if sym<> period then
    error(9);
  if err = 0 then
    interpret
  else
    write('errors in PL/0 Program');
99:
  writeln
end.