pl／0编译程序.txt

PL／0语言的文法规则 说明 (1)对原PL／0编译程序作了如下修改： 1’增加了输入文件ff和fi,输出文件fw2。 2’增加了保留字read和write

PL／0编译程序

　　1)PL／0编译程序
 program plO(input，output，ff，fi，fw2)；{带有代码生成的PL／0编译程序}
   label 99；
   const norw＝13；  {保留字个数}
　　　　 txmax=100，  {标识符表的长度}
         nmax=14，  {数中数字的最大个数}
         a1=10；  {标识符的长度}
         amax＝20471；{最大地址}    
         levmax＝3；    {程序体嵌套的最大深度)
         cxmax＝200；  {代码数组的大小}
         writex=20；
   type symbol=(nul，ident，number，plus，minus，times，slash，oddsym，eql，neq，lss，leq，gtr，geq，lparen，rparen，comma，semicolon，period，becomes，beginsym， endsym，ifsym，thensym，whilesym，dosym，callsym，constsym，varsym，procsym，readsym，writesym，upcomma) ；
　　　　alfa＝packed array[1..a1] of char；
　　　　object＝(constant，variable，proceable) ；
　　　　symset＝set Of symbol；
　　　　fct=(1it，opr，lod，sto，cal，int，jmp，jpc)；{functions}
　　　　instruction=packed record
                       f：fct ；    {功能码}
                       l: 0..1evmax；{层}
                       a：0..amax；  {相对地址)
　　　　　　　　　　end；
   {lit  0，a  ：取常数a
    opr  0，a：执行运算a
    lod  l，a：取层差为l，相对地址为a的常量
    sto  l，a：存到层差为l，相对地址为a的变量
    cal  l，a：调用层差为l的过程
    int  0，a  ：t寄存器增加a
    jmp  0，a，转移到指令地址a处
    jpc  0，a：条件转移到指令地址a处}
  var ff,fi：text；    {输入文件名ff和fi}
     fw2：text；    {输出文件名fw2}
     ch：char；    {最近读到的字符}
     sym：symbol；  {最近读到的符号}
     id：alfa；    {最近读到的标识符}
     num：integer；  {最近读到的数}
     cc：integer；    {字符计数}
     ll：integer；    {行长}
     wx：integer；
     kk，err，cw：integer；
     cx：integer；    {代码分配下标}
     line：array[1..81]of char；
     a：alfa；
     chwr：array[1..writex] of alfa；
     code：array[0..cxmax] of instruction；
     word：array[1..norw] of alfa；
     wsym：array[1..norw] of symbol；
     ssym：array[char] of symbol；
     mnemonic：array[fct] of packed array[1..3] of char；
     declbegsys，statbegsys，facbegsys：symset；
     table：array[0..txmax] of record
　　　　　　　　name：alfa；
　　　　　　　　case kind：object of
　　　　　　　　  constant：(val：integer)；
　　　　　　　　  variable，proceable：(1evel，dr：integer)；
　　　　　　end；
procedure error(n:integer)；  {出错显示子程序}
    begin  writeln(fw2，’****’,’’：cc，n：2)：
           err:=err+1；
    end；
procedure getsym；    {读单词子程序}
  var i，j，k：integer；
  procedure getch    {读字符子程序}
    begin if cc=ll then
             begin if eof(ff) then  
                      begin write(fw2，’program incompletet’)；  goto  99；end；
                   ll:=O；cc:=0；write(fw2，cw：5，’ ’)；cw:=cw+1；
                   while not(eoln(ff)) do
                     begin  ll:=ll+1 ；read(ff，ch) ；write(fw2，ch) ； line[ll]:=ch；
                     end； 
                   writeln(fw2)；ll:=ll+1；read(ff，1ine[ll]) ；
              end；
              cc:=cc+l；ch:=line[cc] ；
    end；    {读字符子程序结束}
  begin  {读单词子程序开始}
    while ch＝’ ’ do getch；
    if ch in [’a’..’z’] then
       begin kc:=0；
             repeat if k<a1 then
                       begin k:=k+1；a[k]:=ch；  end；
                    getch；
             until not(ch in[’a’..’z’，’0’..’9’])； 
             if k>=kk then   kk:=k
                      else repeat a[kk]:=’ ’ ；kk:=kk-1；
                           untll kk=k；
             id:=a；i:=1；j:=norw；
             repeat k=(i+j) div 2；
                    if id<=word[k] then j:=k-1；
                    if id>=word[k] then i:=k+1；
             untll i>j；
             if i-1>j then sym:=wsym[k]
                      e1se sym:=ident；
    end    {标识符或保留字处理结束}
    else if ch in  [’0’..’9’] then   
            begin   {数处理}
              k:=0；num:=0；sym:=number；
              repeat num:=10*num+(Ord(ch)一Ord(’0’))；   k:=k+1；getch；
              until not(ch in[’0’..’9’]) ；
              if k>nmax then error(30)
            end    {数处理结束}
         e1se if ch＝’:’ then
                 begin getch；
                       if ch=’=’ then
                          begin sym:=becomes；getch；  end
                          else sym:=nul；
                 end
                else case ch of
        ’+’，’-’，’*’，’／’’(’，’)’，’=’,’,’,’ ；’,’.’：begin sym:=ssym[ch] ；
                                                                  getch；
                                                             end；
　　　　’>’：begin getch；
                   if ch=’=’ then   begin sym:=geq；getch；end
                             else sym:=gtr；
             end；
        ’<’：begin getch；
                   if ch=’=’ then   begin sym:=leq；getch；end
                              else if ch=’>’ then
                                       begin sym:=neq；getch；end
                                      else sym:=lss；
　　　　　　　end
    end ； {case  }
  end； {读单词子程序结束}

procedure gen(x：fct；y，z：integer) ； {代码生成子程序}
    begin if cx>cxmax then
             begin write(’program too long’) ；  goto 99    end；
          with code[cx] do
              begin  f:=x；l:=y；a:=z  end；
          cx:=cx+1
　　end；    {代码生成子程序结束}    
procedure test(s1，s2：symset；n：integer) ；
    begin if not(sym in s1) then
              begin error(n)；s1:=s1+s2；
                    while not(sym in s1)do getsym
              end；
    end；
procedure block(1ev，tx：integer；fsys：symset)；  {分程序处理模块}
  var dx  ：integer；    {数据分配下标}
      txO：integer；    {起始标识符的下标}
      cxO：integer；    {起始代码的下标}
  procedure enter(k：object)；{把object填入标识符表中}
    begin tx：＝tx+1；
          with table[tx] do
               begin name:=id；kind:=k；
                     case kind of
                          constant：begin if num>amax then
                                             begin error(30)；num:=0 ； end；
                                          val:=num；
                                    end；
                          variable：begin level:=levl；dr:=dx；dx:=dx+l；end；
                          proceable：level:=lev
                     end    {  case  }
               end
    end；  {填标识符表子程序结束}
    function position(id：alfa)：integer；  {  在标识符表中查标识符id  }
      var i：integer；
      begin table[0].name:=id；i:=tx；
            while table[I].name<>id do  i:=i-1；
            position:=i；
      end；  {position}
    procedure constdeclaration；  {常量说明处理子程序}
      begin if sym=ident then
               begin getsym；
                     if sym in [eql，becomes] then
                        begin if sym＝becomes then error(1)；
                              getsym；
                              if sym=number then
                                 begin enter(constant) ；
                                       getsym；
                                 end
                                else error(2)
                        end 
                       else error(3)
                   end else error(4)
    end；    {constdeclaration}
    procedure vardeclaration；  {变量说明处理子程序}
    begin if sym=ident then
             begin enter(variable) ；getsym； end 
            else error(4)
    end；{  vardeclaration  }
  procedure listcode；    {列出本程序体生成的代码子程序}
    var i：integer；
    begin for i:=cxO to cx-1 do
              with code[i] do
                 writeln(fw2，i，mnemonic[i]：5，l:3，a：5)
    end；  {listcode  }
  procedure statement(fsys：symset)；{语句处理子程序}
    var i，cxl，cx2．integer；
    procedure expression(fsys:symset)；  {表达式处理子程序}
      var addop：symbol；
      procedure term(fsys:symset) ；   {项处理子程序}
        var mulop：symbol；
        procedure factor(fsys：symset)；  {因子处理子程序}
          var i：integer；
          begin test(facbegsys，fsys，24) ；
                while sym in facbegsys do
                   begin if sym=ident then
                            begin i:=position(id)；
                                  if i=0 then error(11)
                                     else with table[i] do
                                          case kind of
                                            constant：gen(1it，0，val)；
                                            variable：gen(lod，lev-level，dr)；
                                            proceable：error(21)
                                          end；
                                  getsym；
                            end
                           else
                            if sym=number then
                               begin if num>amax then
                                        begin error(30) ；num:=O；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，[1paren]，23)
　　　　　　　　　  end
    end；  {factor}
    begin  {项处理子程序开始}
      factor(fsys+[times，slash]) ；
      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；  {项处理子程序结束}
    begin    {表达式处理子程序开始)
      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 add／p:=sym；getsym；
               term(fsys+[plus，minus])；
               if addop=plus then
                   gen(opr，0，2)
                 else gen(opr，0，3)
         end
　　end；{exprssion}
  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，1ss，gtr，leq，geq]+fsys) ；
                        if not(sym in[eql，neq，1ss，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) ；
                                        1eq：gen(opr，0，13) ；
                                     end
                               end