yufafenxi.pas

delphi编的pl0编译器

unit YuFaFenXi;

interface
uses
  SysUtils,Defination,Main;


var
  table:array[0..1000] of record
                        name:alfa;
                        kind:integer;
                        value:integer;
                        level:integer;
                        adr:integer;
                        size:integer;
        end;

  table_index:integer;
  err:integer;

  ident_kind:integer;

  temp_wordlist_index:integer;
  if_end:boolean;
procedure Analyze;

implementation


procedure error(n:integer;line:integer);
begin

  inc(err);
  Mainform.Memo2.Lines.Append('行号:'+inttostr(line));
  mainform.Memo2.Lines.Append('   '+
                              wordlist[temp_wordlist_index].name+
                              '    :'
                              +'             '+errlist[n]);
  if line<=30 then
    error_mark[line]:=1;
  
end;

procedure Advance;
begin

  if temp_wordlist_index>=wordlist_index then
  begin
    if_end:=true;
    exit;
  end;
  inc(temp_wordlist_index);
end;

procedure test(s1,s2:symset;n:integer);
begin
  if not(wordlist[temp_wordlist_index].symb in s1+[period]) then
  begin
    error(n,wordlist[temp_wordlist_index].info);
    s1:=s1+s2;
    while not(wordlist[temp_wordlist_index].symb in s1) do
      if if_end then exit
      else Advance;
  end;
end;




procedure block(lev,table_index:integer;fsys:symset);    //分程序段
var
  tx0:integer;//初始化table表
  data_index:integer;

  procedure enter(n:integer);       //建立符号表
  
  begin
    inc(table_index);

      table[table_index].name:=wordlist[n].name;
      if ident_kind=7 then
      begin
        table[table_index].kind:=7;
        table[table_index].level:=lev;
      end;
      if ident_kind=5 then
      begin
        table[table_index].kind:=888;
        table[table_index].level:=lev;
        table[table_index].adr:=data_index;
        inc(data_index);
      end;
      if ident_kind=6 then
      begin
        table[table_index].name:=wordlist[n-2].name;
        table[table_index].kind:=999;
        table[table_index].value:=wordlist[n].value;
      end;
 
    
  end;//enter

  function position(id:alfa):integer;     //查找符号表
  var
    i:integer;
  begin
      table[0].name:=id;
      i:=table_index;
      while table[i].name<>id do dec(i);
      result:=i;
  end;

  procedure constdeclaration;        //常量定义处理
  begin
    if wordlist[temp_wordlist_index].symb=ident then
    begin
      Advance;
      if if_end then exit;//////////////

      if wordlist[temp_wordlist_index].symb in [eql,becomes] then
      begin
        if wordlist[temp_wordlist_index].symb=becomes then
          error(1,wordlist[temp_wordlist_index].info);
        Advance;
        if if_end then exit;//////////////////
        if wordlist[temp_wordlist_index].symb=number then
        begin
          enter(temp_wordlist_index);
          Advance;
          if if_end then exit;///////////////////////
        end
        else error(2,wordlist[temp_wordlist_index].info);
      end
    else error(3,wordlist[temp_wordlist_index].info);
    end
    else error(4,wordlist[temp_wordlist_index].info)
  end;

  procedure vardeclaration;           //变量定义处理
  begin
    if wordlist[temp_wordlist_index].symb=ident then
    begin
      enter(temp_wordlist_index);
      Advance;
      if if_end then exit;///////////////////////////
    end
    else error(4,wordlist[temp_wordlist_index].info);
  end;



  procedure statement(fsys:symset);         //语句处理
  var
    i:integer;

    procedure expression(fsys:symset);       //表达式处理
//    var
//      addop:symbol;

      procedure term(fsys:symset);           //项处理


        procedure factor(fsys:symset);       //因子处理
        var
          i:integer;
        begin
          test(facbegsys,fsys,24);
          while wordlist[temp_wordlist_index].symb in facbegsys do
          begin
            if wordlist[temp_wordlist_index].symb=ident then
            begin
              i:=position(wordlist[temp_wordlist_index].name);
              if i=0 then error(11,wordlist[temp_wordlist_index].info)
              else if table[i].kind=7 then
                error(21,wordlist[temp_wordlist_index].info);//7为procedure
              advance;
          //    if i=3 then;///////////////
            end
            else
            if wordlist[temp_wordlist_index].symb=number then
            begin
              advance;
              if if_end then exit;////////////////////
            end
            else if wordlist[temp_wordlist_index].symb=lparen then
            begin
              advance;
              if if_end then exit;//////////////////
              expression([rparen]+fsys);
              if wordlist[temp_wordlist_index].symb=rparen then
              begin
                advance;
                if if_end then exit;/////////////
              end
              else error(22,wordlist[temp_wordlist_index].info)
            end;
          if if_end then exit;
          test(fsys,facbegsys,23);
          end;
        end;


      begin//term
        factor([times,slash]+fsys);
        while wordlist[temp_wordlist_index].symb in [times,slash] do
        begin
          advance;
          if if_end then exit;////////////////
          factor(fsys+[times,slash]);
        end;
      end;//term


    begin//expression
      if wordlist[temp_wordlist_index].symb in [plus,minus] then
      begin
        advance;
        if if_end then exit;///////////////////
        term(fsys+[plus,minus]);
      end
      else term(fsys+[plus,minus]);
      while wordlist[temp_wordlist_index].symb in[plus,minus] do
      begin
        advance;
        if if_end then exit;/////////////////
        term(fsys+[plus,minus]);
      end;
    end;//expression


  procedure condition(fsys:symset);             //条件处理
  begin
    if wordlist[temp_wordlist_index].symb=oddsym then
    begin
      advance;
      if if_end then exit;/////////////////////
      expression(fsys);
    end
    else
    begin
      expression([eql,neq,lss,leq,gtr,geq]+fsys);
      if not (wordlist[temp_wordlist_index].symb in [eql,neq,lss,leq,gtr,geq])
        then error(20,wordlist[temp_wordlist_index].info)
      else
      begin
        advance;
        if if_end then exit;////////////////////////////
        expression(fsys);
      end;
    end;
  end;


  begin//statement
    if wordlist[temp_wordlist_index].symb=ident then
    begin
      i:=position(wordlist[temp_wordlist_index].name);
      if i=0 then error(11,wordlist[temp_wordlist_index].info)
      else
      if table[i].kind<>888 then
      begin
        error(12,wordlist[temp_wordlist_index].info);
        i:=0;
      end;
      advance;
      
      if if_end then exit;
      if wordlist[temp_wordlist_index].symb=becomes then
      begin
        advance;
        if if_end then exit;////////////////////////////
      end
      else error(13,wordlist[temp_wordlist_index].info);
      expression(fsys);
    end
    else
    if wordlist[temp_wordlist_index].symb=readsym then
    begin
      advance;
      if if_end then exit;////////////////////////////
      if wordlist[temp_wordlist_index].symb<>lparen then
        error(34,wordlist[temp_wordlist_index].info)
      else
      repeat
        advance;
        if if_end then exit;////////////////////////////
        if wordlist[temp_wordlist_index].symb=ident then i:=
                              position(wordlist[temp_wordlist_index].name)
        else i:=0;
        if i=0 then error(35,wordlist[temp_wordlist_index].info);
        advance;
        if if_end then exit;////////////////////////////
      until wordlist[temp_wordlist_index].symb<>comma;
      if wordlist[temp_wordlist_index].symb<>rparen then
      begin
        error(33,wordlist[temp_wordlist_index].info);
        while not (wordlist[temp_wordlist_index].symb in fsys) do
        begin
          advance;
          if if_end then exit;////////////////////////////
        end
      end
      else
      begin
        advance;
        if if_end then exit;////////////////////////////
      end;
    end

    else
    if wordlist[temp_wordlist_index].symb=writesym then
    begin
      advance;
      if if_end then exit;////////////////////////////
      if wordlist[temp_wordlist_index].symb=lparen then
      begin
        repeat
          advance;
          if if_end then exit;////////////////////////////
          expression([rparen,comma]+fsys);
        until wordlist[temp_wordlist_index].symb<>comma;
        if wordlist[temp_wordlist_index].symb<>rparen then
          error(33,wordlist[temp_wordlist_index].info)
        else
        begin
          advance;
          if if_end then exit;////////////////////////////
        end;
      end;
    end

    else
    if wordlist[temp_wordlist_index].symb=callsym then
    begin
      advance;
      if if_end then exit;////////////////////////////
      if wordlist[temp_wordlist_index].symb<>ident then
        error(14,wordlist[temp_wordlist_index].info)
      else
      begin
        i:=position(wordlist[temp_wordlist_index].name);
        if i=0 then error(11,wordlist[temp_wordlist_index].info)
        else
        if table[i].kind<>7 then error(15,wordlist[temp_wordlist_index].info);
        advance;
        if if_end then exit;////////////////////////////
      end;
    end

    else
    if wordlist[temp_wordlist_index].symb=ifsym then
    begin
      advance;
      if if_end then exit;////////////////////////////
      condition([thensym,dosym]+fsys);
      if wordlist[temp_wordlist_index].symb=thensym then
      begin
        advance;
        if if_end then exit;////////////////////////////
      end
      else error(16,wordlist[temp_wordlist_index].info);
      statement(fsys);
    end

    else
    if wordlist[temp_wordlist_index].symb=beginsym then
    begin
      advance;
      if if_end then exit;////////////////////////////
      statement([semicolon,endsym]+fsys);
      while wordlist[temp_wordlist_index].symb in[semicolon]+statbegsys do
      begin
        if wordlist[temp_wordlist_index].symb=semicolon then
        begin
          advance;
          if if_end then exit;////////////////////////////
        end
        else error(10,wordlist[temp_wordlist_index].info);
        statement([semicolon,endsym]+fsys);
      end;
      if wordlist[temp_wordlist_index].symb=endsym then
      begin
        advance;
        if if_end then exit;////////////////////////////
      end
      else error(17,wordlist[temp_wordlist_index].info)
    end

    else
    if wordlist[temp_wordlist_index].symb=whilesym then
    begin
      advance;
      if if_end then exit;////////////////////////////
      condition([dosym]+fsys);
      if wordlist[temp_wordlist_index].symb=dosym then
      begin
        advance;
        if if_end then exit;////////////////////////////
      end
      else error(18,wordlist[temp_wordlist_index].info);
      statement(fsys);
    end;
    test(fsys,[],19);
  end;



begin//block
  data_index:=3;
  tx0:=table_index;
//  table[table_index].adr:=
  repeat
    if wordlist[temp_wordlist_index].symb=constsym then
    begin
      ident_kind:=6;
      advance;
      if if_end then exit;////////////////////////////
      repeat
        constdeclaration;
        while wordlist[temp_wordlist_index].symb=comma do
        begin
          advance;
          if if_end then exit;////////////////////////////
          constdeclaration;
        end;
        if wordlist[temp_wordlist_index].symb=semicolon then
        begin
          advance;
          if if_end then exit;////////////////////////////
        end
        else error(5,wordlist[temp_wordlist_index].info);
      until wordlist[temp_wordlist_index].symb<>ident;
    end;
    if wordlist[temp_wordlist_index].symb=varsym then
    begin
      ident_kind:=5;
      advance;
      if if_end then exit;////////////////////////////
      repeat
        vardeclaration;
        while wordlist[temp_wordlist_index].symb=comma do
        begin
          advance;
          if if_end then exit;////////////////////////////
          vardeclaration;
        end;
        if wordlist[temp_wordlist_index].symb=semicolon then
        begin
          advance;
          if if_end then exit;////////////////////////////
        end
        else error(5,wordlist[temp_wordlist_index].info);
      until wordlist[temp_wordlist_index].symb<>ident;
    end;
    while wordlist[temp_wordlist_index].symb=procsym do
    begin
      ident_kind:=7;
      advance;
      if if_end then exit;////////////////////////////
      if wordlist[temp_wordlist_index].symb=ident then
      begin
        enter(temp_wordlist_index);
        advance;
        if if_end then exit;////////////////////////////
      end
      else error(4,wordlist[temp_wordlist_index].info);
      if wordlist[temp_wordlist_index].symb=semicolon then
      begin
        advance;
        if if_end then exit;////////////////////////////
      end
      else error(5,wordlist[temp_wordlist_index].info);
      block(lev+1,table_index,[semicolon]+fsys);
      if wordlist[temp_wordlist_index].symb=semicolon then
      begin
        advance;
        if if_end then exit;////////////////////////////
        test(statbegsys+[ident,procsym],fsys,6);
      end
      else error(5,wordlist[temp_wordlist_index].info);
    end;
    ////////////////////////////////////////////

    /////////////////////////////////////////
    test(statbegsys+[ident]+[semicolon],declbegsys,7);
  until not (wordlist[temp_wordlist_index].symb in declbegsys);


  if if_end then exit;

  with table[tx0] do
  begin
    size:=data_index;
  end;

  statement([semicolon,endsym]+fsys);
  test(fsys,[],8);
  
end;




procedure Analyze;        //语法分析

begin


  Initialize;

  err:=0;
  if_end:=false;
  temp_wordlist_index:=1;
  table_index:=0;

  declbegsys:=[constsym,varsym,procsym];
  statbegsys:=[beginsym,callsym,ifsym,whilesym];
  facbegsys:=[ident,number,lparen];

  if temp_wordlist_index>wordlist_index then
  begin
    error(9,1);

    exit;
  end;

  block(0,0,[period]+declbegsys+statbegsys);

  if if_end then exit;////////////////////////////

  if wordlist[temp_wordlist_index].symb<>period then
    error(9,wordlist[temp_wordlist_index].info);

  if err=0 then
  begin
    MainForm.Memo2.Lines.Append('  程序无语法错误，可以继续编译!');
    MainForm.N13.Enabled:=true;
  end;
end;

initialization err:=1;
end.