pl0.dpr

数据结构中编译器的算法

(********************* PL0 编译程序Turbo Pascal代码 *********************)
program pl0(fa,fa1,fa2);
(*fa,fa1,fa2在Borland Delphi编译器中无意义，只是起提示作用*)
(*fa1：屏幕跟踪文件，操作过程中显示的文字写到该文件中 *)
(* PL0 compile with code generation *) 
  
label 99; 
      (* Turbo Pascal do not support goto between different
         blocks so, the 'goto' command in getch are replaced 
         by procedure exitp !! in another way, 'label 99' do 
         not work !!                  Lin Wei       2001  *) 
  
const norw=13;       (* of reserved words *) 
      txmax=100;     (* length of identifier table *) 
      nmax=14;       (* max number of digits in numbers *) 
      al=10;         (* length of identifiers *)
      amax=2047;     (* maximum address 最大的地址*)
      levmax=3;      (* max depth of block nesting *) 
      cxmax=200;     (* size of code array 指令代码数组的大小,见code[]*)

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,writesym,readsym,dosym,callsym,
             constsym,varsym,procsym);  (*源文件中单词或符号的类型*)

     alfa=packed array[1..al] of char; (*字符串的类型*)
     objects=(constant,variable,procedur);  (*见名字表table *)
     (* wirth used the word "procedure"and"object" there, which won't work! *)
     symset=set of symbol;
     fct=(lit,opr,lod,sto,cal,int,jmp,jpc);   (*8个目标指令功能代码 *)
     instruction=packed record    (*指令记录类型  page23 *)
                    f:fct;        (* function code 功能码*)
                    l:0..levmax;  (* level 层次差*)
                    a:0..amax;    (* displacement addr 不同的指令含义不同*)
                      (*注意，在实际运算过程中，a可以超过amax，而不会有整数溢出*)
                 end; 
              (* lit 0,a load constant a 
                 opr 0,a execute opr a 
                 lod 1,a load variable 1,a 
                 sto 1,a store variable 1,a 
                 cal 1,a call procedure at level 1
                 int 0,a increment t -register by a 
                 jmp 0,a jump to a 
                 jpc 0,a jump conditional to a *) 
  
var fa:text; 
    fa1,fa2:text;
    listswitch:boolean;    (* true set list object code *)
    ch:char;               (* last char read *)
    sym:symbol;            (* last symbol read 最近读取的符号（标识符或关键字）*)
    id:alfa;               (* last identifier read *)
    num:integer;           (* last number read *)
    cc:integer;            (* character count *)
    ll:integer;            (* line length *) 
    kk:integer;
    cx:integer;            (* code allocation index 代码分配索引值，即code[]的下标*)
    line:array[1..81] of char;
    a:alfa;     (*标识符的全局变量 *)
    code:array[0..cxmax] of instruction;
    word:array[1..norw] of alfa; (*所有13个关键字的数组 *)
    wsym:array[1..norw] of symbol; 
    ssym:array[' '..'^'] of symbol;
        (* wirth uses "array[char]" here *) 
    mnemonic:array[fct] of packed array[1..5] of char;
    declbegsys, statbegsys, facbegsys:symset;
    (*facbegsys factor begin symset 因子开始符号集*)

    (*表2.2 名字索引表table Page22 *)
    (*tx为名字索引表的指针*)
    (*dx表示给本层局部变量分配的相对位置，每说明完一个变量后dx加1 *)
    table:array[0..txmax] of record
            name:alfa;     (*常量，变量，过程的名称 *)
            case kind:objects of  (*kind:名字类型  *)
              constant:(val:integer); (*如果名字类型是常量,val有意义 *)
              variable,procedur:(level,adr,size:integer)
            (*"size" lacking in original. I think it belongs here *) 
          end;
(*    fin,fout:text;*)
    fin:text;
    fname:string; (*pl0源程序文件的名称 *)
    err:integer; (*错误总数 *)
    endf:boolean;

(*错误处理 n为错误号*)
(*注意，错误处理后，并不退出编译过程*)
procedure error(n:integer); 
begin
  writeln('****','':cc-1,'!',n:2); 
  writeln(fa1,'****','':cc-1,'!',n:2);
  err:=err+1;
end; (* error *) 
  
procedure exitp; 
begin 
  endf:=true; 
  close(fin); 
  writeln;
  exit; 
end;

(*getsym的功能是读句子中的一个符号（单词）：

 滤空格

每次读一个符号symbol
如果符号是13个保留字如：begin,if end，
或者是运算符，如 + - * / # >= := <=，
或者是界符如 ( ) ; . ,等
以上3种情况下，             对应的保留字放入sym中,    id无意义            num无意义

如果符号是自定义的标识符,    ident放入sym中           标识符串放入id中    num无意义

如果符号是数字串，           number放入sym中          id无意义            数本身的二进制值放入num中

第读完一个符号（单词）后，还要读单词后面的一个字符。*)

procedure getsym;
var i,j,k:integer;
  procedure getch; 
  begin
    if cc=ll then begin (*如果读完了一行，需要读下一个新行*)
      if eof(fin) then begin   (*但是又到了文件尾，说明文件不完整*)
         write('program incomplete');
         close(fin);
         writeln;
readln;
         exitp;
         (*goto 99;*)
      end;
      (*需要读下一个新的行*)
      ll:=0;
      cc:=0;
      write(cx:4,' ');       (*显示cx后面再跟一个空格，:4是显示的格式，表示右对齐，左添空格*)
      write(fa1,cx:4,' ');
      (*下面读一整行到line[]中，并设置行的长度为ll ,注意在line后面多加了一个空格*)
      while not eoln(fin) do begin
        ll:=ll+1;
        read(fin,ch);   (*从源文件中读一个字符*)
        write(ch);      (*显示字符ch*)
        write(fa1,ch);  (*在屏幕跟踪文件fa1中写入ch*)
        line[ll]:=ch;
      end;
      writeln;
      ll:=ll+1;
      (* read(fin,line[ll]); repleaced by two lines below *)
      line[ll]:=' '; (*多加一个空格*)
      readln(fin); (*读完该行最后的回车换行符。*)
      writeln(fa1);(*写一个回车换行符到fa1中*)
    end;   (* if cc=ll then begin (*如果读完了一行*)
    cc:=cc+1;
    ch:=line[cc];
  end; (* getch *)
begin (* getsym *)
  while ch=' ' do getch; (*首先去掉所有前导空格 *)
  if ch in ['a'..'z'] then begin  (*如果是字母，则按标识符或关键字方式处理 *)
     k:=0; (*标识符或关键字长度清0*)
     repeat
       if k<al then begin
          k:=k+1;
          a[k]:=ch;
       end;
       getch;
     until not(ch in ['a'..'z','0'..'9']);(*如果是字母，循环直到下一个不是字母或数字*)
     if k>=kk then kk:=k (*如果标识识长度>=kk(标识符最大长度暂时为kk),那么设置kk为标识符新的最大长度k*)
     else repeat  (*否则，把a[]的后面的其余的位置写为空格。如'const'应写为'const     ';*)
            a[kk]:=' ';
            kk:=kk-1; 
          until kk=k;
     id:=a;  (*值a放在id中*)
     (*下面用折半查找方式来判断id是标识符还是关键字*)
     (*在折半查找中 i是左标识,j是右标识 *)
     i:=1;
     j:=norw; (*norw关键字数量 *)
     repeat
       k:=(i+j) div 2;
       if id<=word[k] then j:=k-1; 
       if id>=word[k] then i:=k+1; 
     until i>j;
     (*如果找到了，id就是关键字，类型为wsym[k]，否则id为标识符,类型为ident *)
     if i-1>j then sym:=wsym[k] else sym:=ident;
  end else if ch in ['0'..'9'] then begin (* number *)  (*如果是数字开头，按数字类型处理*)
    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 else if ch=':' then begin  (*如果是:或:= *)
    getch;
    if ch='=' then begin
       sym:=becomes;
       getch;
    end else sym:=nul;
  end else if ch='<' then begin  (*如果是<或<= *)
    getch;
    if ch='=' then begin
       sym:=leq;
       getch;
    end else sym:=lss;
  end else if ch='>' then begin  (*如果是>或>=*)
    getch;
    if ch='=' then begin
       sym:=geq;
       getch;
    end else sym:=gtr;
  end else begin (*如果是其他11个符号：+ - * / ( ) = , . # ;*)
    sym:=ssym[ch];
    getch;
  end;
end; (* getsym *)

(*把由x,y,z构成的一条目标指令代码写入code[]中。*)
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; (* gen *)

(*测试程序，见Page25*)
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; (* test *)

(*除主程序外，语法语义分析处理由BLOCK完成。见图2.8 page22*)
(*lev:初始层次 *)
(*tx:初始名字表的指针，已经指向名字表的最后一条记录 *)
(*fsys:类型符号集*)
procedure block(lev,tx:integer;fsys:symset);
var dx:integer;   (* data allocation index 数据分配索引，即表示给本层局部变量分配的相对位置，每说明完一个变量后dx加1 *)
    tx0:integer;  (* inital table index 初始名字表索引值*)
    cx0:integer;  (* inital code index *)

    procedure enter(k:objects);
    begin (* enter object into table 加入说明对象到名字表table中 *)
      tx:=tx+1;
      with table[tx] do begin
        name:=id; (*name即为table[tx].name，因为有了With ... 所以可以省略table[tx].前缀*)
        kind:=k;
        case k of
          constant: begin
                      if num>amax then begin error(31); num:=0; end;
                      val:=num;
                    end;
          variable: begin
                      level:=lev;
                      adr:=dx;
                      dx:=dx+1;
                    end;
          procedur: level:=lev; (*过程的adr(入口地址)不在这里填写，而在目标代码生成时反填。*)
        end;
      end;
    end; (* enter *)

    (*当遇到标识符引用时就调用position函数查table表，看是否有过正确的定义id*)
    (*返回0：未找到，*)
    (*返回非0，找到，返回值为id在table表中的下标*)
    function position(id:alfa):integer;
    var i:integer;
    begin (* find identifier in table *)
      table[0].name:=id;
      i:=tx;
      while table[i].name<>id do i:=i-1;
      position:=i;
    end; (* position *)

    (*常量说明处理  见图2.8 *)
    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 *)
    
    (*变量说明处理 见图2.8 *)
    procedure vardeclaration;
    begin 
      if sym=ident then begin 
         enter(variable); 
         getsym; 
      end else error(4);
    end; (* vardeclaration *) 

    procedure listcode; 
    var i:integer; 
    begin
      if listswitch then begin (*如果用户选择了列表 *)
         for i:=cx0 to cx-1 do 
             with code[i] do begin
                  writeln(i:2,mnemonic[f]:7,l:3,a:5);
                  writeln(fa,i:2,mnemonic[f]:7,l:3,a:5);
             end; 
      end; 
    end; (* listcode *) 
  
    procedure statement(fsys:symset);
    var i,cx1,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(lit,0,val);
                           variable:gen(lod,lev-level,adr); 
                           procedur:error(21);
                         end;
                       getsym; 
                    end else if sym=number then begin
                        if num>amax then begin 
                           error(31);