PL/0與Pascal-S編譯器程序詳細註釋

　　學校編譯課的做業之一,要求閱讀兩個較爲簡單的編譯器的代碼並作註釋, 我的感受是一次挺有意義的鍛鍊, 將本身的心得分享出來與一同在進步的同窗們分享. 從此有時間再作進一步的更新和總結,其中可能有很多錯誤,也請各位大佬不吝指正. 代碼能夠經過使用Lazarus等pascal環境執行。

源碼倉庫：https://github.com/luxiaodou/Pascal-S-and-PL0-complier-comments

PL0編譯器源碼

PL0語言是Pascal的一個子集，編譯器也比較簡單，逐行註釋

program pl0 ;  { version 1.0 oct.1989 }
{ PL/0 compiler with code generation }    
{    comment by Song Lu
    Department of Computer Science&Engineering BUAA,Nov.2016
}
{常量定義}
const norw = 13;          { no. of reserved words }    {保留字的數目}
      txmax = 100;        { length of identifier table }    {符號表長度}
      nmax = 14;          { max. no. of digits in numbers }    {數字的最大長度}
      al = 10;            { length of identifiers }    {標識符的最大長度}
      amax = 2047;        { maximum address }    {相對地址最大值}
      levmax = 3;         { maximum depth of block nesting }     {最大嵌套層數}
      cxmax = 200;        { size of code array }    {生成目標代碼數組最大長度}

{類型變量定義}
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 );    {symbol的宏定義爲一個枚舉}
     alfa = packed array[1..al] of char;    {alfa宏定義爲含有a1個元素的合併數組，爲標識符的類型}
     objecttyp = (constant,variable,prosedure);        {objecttyp的宏定義爲一個枚舉}
     symset = set of symbol;    {symset爲symbol的集合}
     fct = ( lit,opr,lod,sto,cal,int,jmp,jpc,red,wrt ); { functions }    {fct爲一個枚舉，實際上是PCODE的各條指令}
     instruction = packed record    {instruction聲明爲一個記錄類型}
                     f : fct;            { function code }    {函數代碼}
                     l : 0..levmax;      { level }    {嵌套層次}
                     a : 0..amax;        { displacement address }    {相對位移地址}
                   end;
                  {   lit 0, a : load constant a    讀取常量a到數據棧棧頂
                      opr 0, a : execute operation a    執行a運算
                      lod l, a : load variable l,a    讀取變量放到數據棧棧頂，變量的相對地址爲a，層次差爲1
                      sto l, a : store variable l,a    將數據棧棧頂內容存入變量，變量的相對地址爲a，層次差爲1
                      cal l, a : call procedure a at level l    調用過程，過程入口指令爲a,層次差爲1
                      int 0, a : increment t-register by a    數據棧棧頂指針增長a
                      jmp 0, a : jump to a    無條件跳轉到指令地址a
                      jpc 0, a : jump conditional to a    條件轉移到指令地址a
                      red l, a : read variable l,a    讀數據並存入變量，
                      wrt 0, 0 : write stack-top    將棧頂內容輸出
                  }

{全局變量定義}
var   ch : char;      { last character 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,err: integer;    
      cx : integer;   { code allocation index }    {代碼分配指針}
      line: array[1..81] of char;    {緩衝一行代碼}
      a : alfa;    {用來存儲symbol的變量}
      code : array[0..cxmax] of instruction;    {用來保存編譯後的PCODE代碼，最大容量爲cxmax}
      word : array[1..norw] of alfa;    {保留字表}
      wsym : array[1..norw] of symbol;    {保留字表中每一個保留字對應的symbol類型}
      ssym : array[char] of symbol;        {符號對應的symbol類型}
      mnemonic : array[fct] of    {助記符}
                   packed array[1..5] of char;
      declbegsys, statbegsys, facbegsys : symset;    {聲明開始，表達式開始、項開始的符號集合}
      table : array[0..txmax] of    {定義符號表}
                record    {表中的元素類型是記錄類型}
                  name : alfa;    {元素名}
                  case kind: objecttyp of    {根據符號的類型保存相應的信息}
                    constant : (val:integer );    {若是是常量，val中保存常量的值}
                    variable,prosedure: (level,adr: integer )    {若是是變量或過程，保存存放層數和偏移地址}
                end;
      fin : text;     { source program file }    {源代碼文件}
      sfile: string;  { source program file name }    {源程序文件名}

procedure error( n : integer );  {錯誤處理程序}
  begin
    writeln( '****', ' ':cc-1, '^', n:2 );    {報錯提示信息，'^'指向出錯位置，並提示錯誤類型}
    err := err+1 {錯誤次數+1}
  end; { error }

procedure getsym;    {詞法分析程序}
var i,j,k : integer;    {聲明計數變量}
procedure getch;
    begin
      if cc = ll  { get character to end of line }    {若是讀完了一行（行指針與該行長度相等）}
      then begin { read next line }    {開始讀取下一行}
             if eof(fin)    {若是到達文件末尾}
             then begin
                   writeln('program incomplete');    {報錯}
                   close(fin);    {關閉文件}
                   exit;    {退出}
                  end;
             ll := 0;    {將行長度重置}
             cc := 0;    {將行指針重置}
             write(cx:4,' ');  { print code address }    {輸出代碼地址，寬度爲4}
             while not eoln(fin) do    {當沒有到行末時}
               begin
                 ll := ll+1;    {將行緩衝區的長度+1}
                 read(fin,ch);    {從文件中讀取一個字符到ch中}
                 write(ch);    {控制檯輸出ch}
                 line[ll] := ch    {把這個字符放到當前行末尾}
               end;
             writeln;    {換行}
             readln(fin);    {源文件讀取從下一行開始}
             ll := ll+1;    {行長度計數加一}
             line[ll] := ' ' { process end-line }    {行數組最後一個元素爲空格}
           end;
      cc := cc+1;    {行指針+1}
      ch := line[cc]    {讀取下一個字符，將字符放進全局變量ch}
    end; { getch }
  begin { procedure getsym;   }    {標識符識別開始}
    while ch = ' ' do    {去除空字符}
      getch;    {調用上面的getch過程}
    if ch in ['a'..'z']    {若是識別到字母，那麼有多是保留字或標識符}
    then begin  { identifier of reserved word }    {開始識別}
           k := 0;    {標識符指針置零，這個量用來統計標識符長度}
           repeat    {循環}
             if k < al    {若是k的大小小於標識符的最大長度}
             then begin
                   k := k+1;    {k++}
                   a[k] := ch    {將ch寫入標識符暫存變量a}
                 end;
             getch    {獲取下一個字符}
           until not( ch in ['a'..'z','0'..'9']);    {直到讀出的不是數字或字母的時候，標識符結束}
           if k >= kk        { kk : last identifier length }    {若k比kk大}
           then kk := k    {kk記錄當前標識符的長度k}
           else repeat    {循環}
                  a[kk] := ' ';        {標識符最後一位爲空格}
                  kk := kk-1    {k--}
               until kk = k;    {直到kk等於當前標識符的長度，這樣作的意義是防止上一個標識符存在a中的內容影響到當前標識符，好比上一個標識符爲「qwerty」，如今的標識符爲「abcd」，若是不清後幾位則a中會保存"abcdty"，這顯然是錯誤的}
           id := a;    {id保存標識符名}
           i := 1;    {i指向第一個保留字}
           j := norw;   { binary search reserved word table }    {二分查找保留字表，將j設爲保留字的最大數目}
           repeat
             k := (i+j) div 2;    {再次用到k，但這裏只是做爲二分查找的中間變量}
             if id <= word[k]    {若當前標識符小於或等於保留字表中的第k個，這裏的判斷依據的是字典序，那麼咱們能夠推測符號表是按照字典序保存的}
             then j := k-1;        {j = k-1}
             if id >= word[k]    {若當前標識符大於或等於保留字表中的第k個}
             then i := k+1        {i = k+1}
           until i > j;        {查找結束條件}
           if i-1 > j    {找到了}
           then sym := wsym[k]    {將找到的保留字類型賦給sym}
           else sym := ident    {未找到則把sym置爲ident類型，表示是標識符}
         end
    else if ch in ['0'..'9']    {若是字符是數字}
         then begin  { number }
                k := 0;    {這裏的k用來記錄數字的位數}
                num := 0;    {num保存數字}
                sym := number;    {將標識符設置爲數字}
                repeat    {循環開始}
                  num := 10*num+(ord(ch)-ord('0'));    {將數字字符轉換爲數字並拼接起來賦給num}
                  k := k+1;    {k++}
                  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;    {將標識符sym設置爲becomes，表示複製}
                      getch    {讀下一個字符}
                    end
                else sym := nul {不然，將標識符設置爲nul，表示非法}
               end
    else if ch = '<'    {當讀到的字符是'<'時}
           then begin    
                  getch;    {讀下一個字符}
                  if ch = '='    {若讀到的字符是'='}
                  then begin
                         sym := leq;    {則sym爲leq,表示小於等於}
                         getch    {讀下一個字符}
                       end
                  else if ch = '>'    {若讀到的字符是'>'}
                       then begin
                             sym := neq;    {則sym爲neq,表示不等於}
                             getch    {讀下一個字符}
                           end
                  else sym := lss    {不然,sym設爲lss,表示小於}
                end
    else if ch = '>'    {若讀到的是'>'}
            then begin
                   getch;    {讀下一個字符}
                   if ch = '='    {若讀到的是'='}
                   then begin
                          sym := geq;    {sym設爲geq,表示大於等於}
                          getch    {讀下一個字符}
                        end
                   else sym := gtr    {不然,sym設爲gtr,表示大於}
                 end
    else begin    {若非上述幾種符號}
           sym := ssym[ch];    {從ssym表中查到此字符對應的類型,賦給sym}
           getch    {讀下一個字符}
         end
    end; { getsym }

procedure gen( x: fct; y,z : integer );    {目標代碼生成過程,x表示PCODE指令,y,z是指令的兩個操做數}
  begin
    if cx > cxmax    {若是當前生成代碼的行數cx大於容許的最大長度cxmax}
    then begin
           writeln('program too long');    {輸出報錯信息}
           close(fin);    {關閉文件}
           exit    {退出程序}
         end;
    with code[cx] do    {若是沒有超出,對目標代碼cx}
      begin
        f := x;    {令其f爲x}
        l := y;    {令其l爲y}
        a := z    {令其a爲z}    {這三句對應着code身爲instruction類型的三個屬性}
      end;
    cx := cx+1    {將當前代碼行數之計數加一}
  end; { gen }

procedure test( s1,s2 :symset; n: integer );    {測試當前字符合法性過程,用於錯誤語法處理,若不合法則跳過單詞值只讀到合法單詞爲止}
  begin
    if not ( sym in s1 )    {若是當前符號不在s1中}
    then begin
           error(n);    {報n號錯誤}
           s1 := s1+s2;    {將s1賦值爲s1和s2的集合}
           while not( sym in s1) do    {這個while的本質是pass掉全部不合法的符號,以恢復語法分析工做}
             getsym    {得到下一個標識符}
           end
  end; { test }

procedure block( lev,tx : integer; fsys : symset );    {進行語法分析的主程序,lev表示語法分析所在層次,tx是當前符號表指針,fsys是用來恢復錯誤的單詞集合}
  var  dx : integer;  { data allocation index }    {數據地址索引}
       tx0: integer;  { initial table index }    {符號表初始索引}
       cx0: integer;  { initial code index }    {初始代碼索引}

  procedure enter( k : objecttyp );     {將對象插入到符號表中}
    begin  { enter object into table }    
      tx := tx+1;    {符號表序號加一,指向一個空表項}
      with table[tx] do    {改變tx序號對應表的內容}
        begin
          name := id;    {name記錄object k的id,從getsym得到}
          kind := k;    {kind記錄k的類型,爲傳入參數}
          case k of    {根據類型不一樣會進行不一樣的操做}
            constant : begin    {對常量}
                      if num > amax    {若是常量的數值大於約定的最大值}
                      then begin    
                            error(30);    {報30號錯誤}
                            num := 0    {將常量置零}
                           end;
                      val := num    {val保存該常量的值,結合上句能夠看出,若是超過限制則保存0}
                    end;
            variable : begin    {對變量}
                      level := lev;    {記錄所屬層次}
                      adr := dx;    {記錄變量在當前層中的偏移量}
                      dx := dx+1    {偏移量+1,位下一次插入作準備}
                    end;
            prosedure: level := lev;    {對過程,記錄所屬層次}
          end
        end
    end; { enter }

function position ( id : alfa ): integer;    {查找符號表的函數,輸入id爲須要尋找的符號,}
  var i : integer;    {聲明記錄變量}
  begin
    table[0].name := id;    {把id放到符號表0號位置}
    i := tx;    {將i設置爲符號表的最後一個位置,由於符號表是棧式結構,所以按層次逆序查找}
    while table[i].name <> id do    {若是當前表項的name和id不一樣}
       i := i-1;    {再向前找}
    position := i    {找到了,把位置賦值給position返回}
  end;  { position }

procedure constdeclaration;     {處理常量聲明的過程}
    begin
      if sym = ident    {若是sym是ident說明是標識符}
      then begin
             getsym;    {獲取下一個sym類型}
             if sym in [eql,becomes]    {若是sym是等號或者賦值符號}
             then begin
                    if sym = becomes    {如果賦值符號}
                    then error(1);    {報一號錯誤,由於聲明應該使用等號}
                    getsym;  {獲取下一個sym類型}
                    if sym = number    {若是讀到的是數字}
                    then begin
                           enter(constant);    {將該常量入表}
                           getsym    {獲取下一個sym類型}
                         end
                    else error(2)    {若是等號後面不是數字,報2號錯誤}
                  end
             else error(3)    {若是常量標識符後面接的不是等號或賦值符號,報三號錯誤}
           end
      else error(4)    {若是常量聲明第一個符號不是標識符,報4號錯誤}
    end; { constdeclaration }    {常量聲明結束}

  procedure vardeclaration;     {變量聲明過程}
    begin
      if sym = ident    {變量聲明要求第一個sym爲標識符}
      then begin
             enter(variable);    {將該變量入表}
             getsym    {獲取下一個sym類型}
           end
      else error(4)    {若是第一個sym不是標識符,拋出4號錯誤}
    end; { vardeclaration }

  procedure listcode;    {列出PCODE的過程}
    var i : integer;    {聲明計數變量}
    begin
      for i := cx0 to cx-1 do    {全部生成的代碼}
        with code[i] do    {對於每一行代碼}
          writeln( i:4, mnemonic[f]:7,l:3, a:5)    {格式化輸出,分別輸出序號,指令的助記符,層次,地址.實際的輸出效果和咱們實際的PCODE相同}
    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 );    {測試單詞的合法性,判別當前sym是否在facbegsys中,後者在main中定義,若是不在報24號錯誤}
              while sym in facbegsys do    {循環處理因子}
                begin
                  if sym = ident    {若是識別到標識符}
                  then begin
                         i := position(id);    {查表,記錄其在符號表中的位置,保存至i}
                         if i= 0    {若是i爲0,表示沒查到}
                         then error(11)    {報11號錯誤}
                         else
                           with table[i] do    {對第i個表項的內容}
                             case kind of        {按照表項的類型執行不一樣的操做}
                               constant : gen(lit,0,val);    {若是是常量類型,生成lit指令,操做數爲0,val}
                               variable : gen(lod,lev-level,adr);    {若是是變量類型,生成lod指令,操做數爲lev-level,adr}
                               prosedure: error(21)    {若是因子處理中識別到了過程標識符,報21號錯誤}
                             end;
                         getsym    {獲取下一個sym類型}
                       end
                  else if sym = number    {若是識別到數字}
                       then begin
                            if num > amax    {判別數字是否超過規定上限}
                            then begin
                                   error(30);    {超過上限,報30號錯誤}
                                   num := 0    {將數字重置爲0}
                                 end;
                            gen(lit,0,num);    {生成lit指令,將num的值放到棧頂}
                            getsym    {獲取下一個sym類型}
                            end
                       else if sym = lparen    {若是識別到左括號}
                            then begin
                                 getsym;    {獲取下一個sym類型}
                                 expression([rparen]+fsys);    {調用表達式的過程來處理,遞歸降低子程序方法}
                                 if sym = rparen    {若是識別到右括號}
                                 then getsym    {獲取下一個sym類型}
                                 else error(22)    {報22號錯誤}
                               end;
                test(fsys,[lparen],23)    {測試結合是否在fsys中,若不是,拋出23號錯誤}
              end
          end; { factor }
        begin { procedure term( fsys : symset);   
                var mulop: symbol ;    }    {項的分析過程開始}
          factor( fsys+[times,slash]);    {項的第一個符號應該是因子,調用因子分析程序}
          while sym in [times,slash] do    {若是因子後面是乘/除號}
            begin
              mulop := sym;    {使用mulop保存當前的運算符}
              getsym;    {獲取下一個sym類型}
              factor( fsys+[times,slash] );    {調用因子分析程序分析運算符後的因子}
              if mulop = times    {若是運算符是稱號}
              then gen( opr,0,4 )    {生成opr指令,乘法指令}
              else gen( opr,0,5)    {生成opr指令,除法指令}
            end
        end; { term }
      begin { procedure expression( fsys: symset);  
              var addop : symbol; }    {表達式的分析過程開始}
        if sym in [plus, minus]    {若是表達式的第一個符號是+/-符號}
        then begin
               addop := sym;    {保存當前符號}
               getsym;    {獲取下一個sym類型}
               term( fsys+[plus,minus]);    {正負號後面接項,調用項的分析過程}
               if addop = minus    {若是符號開頭}
               then gen(opr,0,1)    {生成opr指令,完成取反運算}
             end
        else term( fsys+[plus,minus]);    {若是不是符號開頭,直接調用項的分析過程}
        while sym in [plus,minus] do    {向後面能夠接若干個term,使用操做符+-相連,所以此處用while}
          begin
            addop := sym;    {記錄運算符類型}
            getsym;    {獲取下一個sym類型}
            term( fsys+[plus,minus] );    {調用項的分析過程}
            if addop = plus    {若是是加號}
            then gen( opr,0,2)    {生成opr指令,完成加法運算}
            else gen( opr,0,3)    {不然生成減法指令}
          end
      end; { expression }

    procedure condition( fsys : symset );     {條件處理過程}
      var relop : symbol;    {臨時變量}
      begin
        if sym = oddsym    {若是當天符號是odd運算符}
        then begin
               getsym;    {獲取下一個sym類型}
               expression(fsys);    {調用表達式分析過程}
               gen(opr,0,6)    {生成opr6號指令,完成奇偶判斷運算}
             end
        else begin
             expression( [eql,neq,lss,gtr,leq,geq]+fsys);    {調用表達式分析過程對錶達式進行計算}
             if not( sym in [eql,neq,lss,leq,gtr,geq])    {若是存在集合以外的符號}
               then error(20)    {報20號錯誤}
               else begin
                      relop := sym;    {記錄當前符號類型}
                      getsym;    {獲取下一個sym類型}
                      expression(fsys);    {調用表達式分析過程對錶達式進行分析}
                      case relop of    {根據當前符號類型不一樣完成不一樣的操做}
                        eql : gen(opr,0,8);    {若是是等號,生成opr8號指令,判斷是否相等}
                        neq : gen(opr,0,9);    {若是是不等號,生成opr9號指令,判斷是否不等}
                        lss : gen(opr,0,10);    {若是是小於號,生成opr10號指令,判斷是否小於}
                        geq : gen(opr,0,11);    {若是是大於等於號,生成opr11號指令,判斷是否大於等於}
                        gtr : gen(opr,0,12);    {若是是大於號,生成opr12號指令,判斷是否大於}
                        leq : gen(opr,0,13);    {若是是小於等於號,生成opr13號指令,判斷是否小於等於}
                      end
                    end
             end
      end; { condition }
    begin { procedure statement( fsys : symset );  
      var i,cx1,cx2: integer; }    {聲明處理過程}
      if sym = ident    {若是以標識符開始}
      then begin
             i := position(id);    {i記錄該標識符在符號表中的位置}
             if i= 0    {若是返回0則是沒找到}
             then error(11)    {拋出11號錯誤}
             else if table[i].kind <> variable    {若是在符號表中找到了該符號,但該符號的類型不是變量}
                  then begin { giving value to non-variation }    {那麼如今的操做屬於給非變量賦值}
                         error(12);    {報12號錯誤}
                         i := 0    {將符號表標號置零}
                       end;
             getsym;    {獲取下一個sym類型}
             if sym = becomes    {若是讀到的是賦值符號}
             then getsym    {獲取下一個sym類型}
             else error(13);    {若是讀到的不是賦值符號,報13號錯誤}
             expression(fsys);    {賦值符號的後面能夠跟表達式,所以調用表達式處理子程序}
             if i <> 0    {若是符號表中找到了合法的符號}
             then
               with table[i] do    {使用該表項的內容來進行操做}
                  gen(sto,lev-level,adr)    {生成一條sto指令用來將表達式的值寫入到相應變量的地址}
          end
      else if sym = callsym    {若是讀到的符號是call關鍵字}
      then begin
             getsym;    {獲取下一個sym類型}
             if sym <> ident    {若是call後面跟的不是標識符}
             then error(14)    {報14號錯誤}
             else begin    {若是沒有報錯}
                    i := position(id);    {記錄當前符號在符號表中的位置}
                    if i = 0    {若是沒有找到}
                    then error(11)    {報11號錯誤}
                    else    {若是找到了}
                      with table[i] do    {對第i個表項作以下操做}
                        if kind = prosedure    {若是該表項的種類爲過程}
                        then gen(cal,lev-level,adr)    {生成cal代碼用來實現call操做}
                        else error(15);    {若是種類不爲過程類型,報15號錯誤}
                    getsym    {獲取下一個sym類型}
                  end
           end
      else if sym = ifsym    {若是讀到的符號是if關鍵字}
           then begin
                  getsym;    {獲取下一個sym類型}
                  condition([thensym,dosym]+fsys);    {if後面跟的應該是條件語句,調用條件分析過程}
                  if sym = thensym    {若是條件語句後面跟的是then關鍵字的話}
                  then getsym    {獲取下一個sym類型}
                  else error(16);    {若是條件後面接的不是then,報16號錯誤}
                  cx1 := cx;    {記錄當前的生成代碼位置}
                  gen(jpc,0,0);    {生成條件跳轉指令,跳轉位置暫填0}
                  statement(fsys);    {分析then語句後面的語句}
                  code[cx1].a := cx    {將以前記錄的代碼的位移地址改寫到如今的生成代碼位置(參考instruction類型的結構)}
                end
           else if sym = beginsym    {若是讀到了begin關鍵字}
                then begin
                       getsym;    {獲取下一個sym類型}
                       statement([semicolon,endsym]+fsys); {begin後面默認接語句,遞歸降低分析}
                       while sym in ([semicolon]+statbegsys) do    {在分析的過程當中}
                         begin
                           if sym = semicolon    {若是當前的符號是分好}
                           then getsym    {獲取下一個sym類型}
                           else error(10);    {不然報10號錯誤}
                           statement([semicolon,endsym]+fsys)    {繼續分析}
                         end;
                       if sym = endsym    {若是讀到了end關鍵字}
                       then getsym    {獲取下一個sym類型}
                       else error(17)    {報17號錯誤}
                     end
                else if sym = whilesym    {若是讀到了while關鍵字}
                     then begin
                            cx1 := cx;    {記錄當前生成代碼的行數指針}
                            getsym;    {獲取下一個sym類型}
                            condition([dosym]+fsys);    {由於while後須要添加循環條件,所以調用條件語句的分析過程}
                            cx2 := cx;    {記錄在分析完條件以後的生成代碼的位置,也是do開始的位置}
                            gen(jpc,0,0);    {生成一個條件跳轉指令,可是跳轉位置(a)置零}
                            if sym = dosym    {條件後應該接do關鍵字}
                            then getsym    {獲取下一個sym類型}    
                            else error(18);    {若是沒接do,報18號錯誤}
                            statement(fsys);    {分析處理循環節中的語句}
                            gen(jmp,0,cx1);        {生成跳轉到cx1的地址,既是從新判斷一遍當前條件是否知足}
                            code[cx2].a := cx    {給以前生成的跳轉指令設定跳轉的位置爲當前位置}
                          end
                 else if sym = readsym    {若是讀到的符號是read關鍵字}
                      then begin
                             getsym;    {獲取下一個sym類型}
                             if sym = lparen    {read的後面應該接左括號}
                             then
                               repeat    {循環開始}
                                 getsym;    {獲取下一個sym類型}
                                 if sym = ident    {若是第一個sym標識符}
                                 then begin    
                                        i := position(id);    {記錄當前符號在符號表中的位置}
                                        if i = 0    {若是i爲0,說明符號表中沒有找到id對應的符號}
                                        then error(11)    {報11號錯誤}
                                        else if table[i].kind <> variable {若是找到了,但該符號的類型不是變量}
                                             then begin
                                                    error(12);    {報12號錯誤,不能像常量和過程賦值}
                                                    i := 0    {將i置零}
                                                  end
                                             else with table[i] do    {若是是變量類型}
                                                   gen(red,lev-level,adr)    {生成一條red指令,讀取數據}
                                     end
                                 else error(4);    {若是左括號後面跟的不是標識符,報4號錯誤}
                                 getsym;    {獲取下一個sym類型}
                               until sym <> comma    {知道如今的符號不是都好,循環結束}
                             else error(40);    {若是read後面跟的不是左括號,報40號錯誤}
                             if sym <> rparen    {若是上述內容以後接的不是右括號}
                             then error(22);    {報22號錯誤}
                             getsym    {獲取下一個sym類型}
                           end
                else if sym = writesym    {若是讀到的符號是write關鍵字}
                     then begin
                            getsym;    {獲取下一個sym類型}
                          if sym = lparen    {默認write右邊應該加一個左括號}
                          then begin
                                 repeat    {循環開始}
                                   getsym;    {獲取下一個sym類型}
                                   expression([rparen,comma]+fsys);    {分析括號中的表達式}
                                   gen(wrt,0,0);    {生成一個wrt海曙，用來輸出內容}
                                 until sym <> comma;    {知道讀取到的sym不是逗號}
                                 if sym <> rparen    {若是內容結束沒有右括號}
                                 then error(22);    {報22號錯誤}
                                 getsym    {獲取下一個sym類型}
                               end
                          else error(40)    {若是write後面沒有跟左括號}
                        end;
      test(fsys,[],19)    {測試當前字符是否合法,若是沒有出如今fsys中,報19號錯}
    end; { statement }
  begin  {   procedure block( lev,tx : integer; fsys : symset );   
    var  dx : integer;  /* data allocation index */
    tx0: integer;  /*initial table index */
    cx0: integer;  /* initial code index */              }    {分程序處理過程開始}
    dx := 3;    {記錄運行棧空間的棧頂位置,設置爲3是由於須要預留SL,DL,RA的空間}
    tx0 := tx;    {記錄當前符號表的棧頂位置}
    table[tx].adr := cx;    {符號表當前位置的偏移地址記錄下一條生成代碼開始的位置}
    gen(jmp,0,0); { jump from declaration part to statement part }    {產生一條jmp類型的無條件跳轉指令,跳轉位置未知}
    if lev > levmax    {當前過程所處的層次大於容許的最大嵌套層次}
    then error(32);    {報32號錯誤}

    repeat    {循環開始}
      if sym = constsym    {若是符號類型是const保留字}
      then begin
             getsym;    {獲取下一個sym類型}
             repeat    {循環開始}
               constdeclaration;    {處理常量聲明}
               while sym = comma do    {若是聲明常量後接的是逗號,說明常量聲明沒有結束,進入下一循環}
                 begin
                   getsym;    {獲取下一個sym類型}
                   constdeclaration    {處理常量聲明}
                 end;
               if sym = semicolon    {若是讀到了分號,說明常量聲明已經結束了}
               then getsym    {獲取下一個sym類型}
               else error(5)    {若是沒有分號,報5號錯誤}
             until sym <> ident    {循環直到遇到下一個標誌符}
           end;
      if sym = varsym    {若是讀到的是var保留字}
      then begin
             getsym;    {獲取下一個sym類型}
             repeat        {循環開始}
               vardeclaration;    {處理變量聲明}
               while sym = comma do    {若是讀到了逗號,說明聲明未結束,進入循環}
                 begin
                   getsym;    {獲取下一個sym類型}
                   vardeclaration    {處理變量聲明}
                 end;
               if sym = semicolon    {若是讀到了分號,說明全部聲明已經結束}
               then getsym    {獲取下一個sym類型}
               else error(5)    {若是未讀到分號,則報5號錯誤}
             until sym <> ident;    {循環直到讀到下一個標識符爲止}
           end;
      while sym = procsym do    {若是讀到proc關鍵字}
        begin
          getsym;    {獲取下一個sym類型}
          if sym = ident    {第一個符號應該是標識符類型}
          then begin
                 enter(prosedure);    {將該符號錄入符號表,類型爲過程,由於跟在proc後面的必定是過程名}
                 getsym    {獲取下一個sym類型}
               end
          else error(4);    {若是第一個符號不是標識符類型,報4號錯誤}
          if sym = semicolon    {若是讀到了分號,說明proc聲明結束}
          then getsym    {獲取下一個sym類型}
          else error(5);    {若是聲明過程以後沒有跟分號,報5號錯誤}
          block(lev+1,tx,[semicolon]+fsys);    {執行分程序的分析過程}
          if sym = semicolon    {遞歸調用返回後應該接分號}
          then begin    {若是接的是分號}
                 getsym;    {獲取下一個sym類型}
                 test( statbegsys+[ident,procsym],fsys,6)    {測試當前的sym是否合法}
               end
          else error(5)    {若是接的不是分號,報5號錯誤}
        end;
      test( statbegsys+[ident],declbegsys,7)    {測試當前的sym是否合法}
    until not ( sym in declbegsys );    {一直循環到sym不在聲明符號集中爲止}
    code[table[tx0].adr].a := cx;  { back enter statement code's start adr. }    {將以前生成無條件跳轉指令的目標地址指向當前位置}
    with table[tx0] do    {對符號表新加記錄}
      begin
        adr := cx; { code's start address }    {記錄當前代碼的分配爲止}
      end;
    cx0 := cx;    {記錄當前代碼分配的地址}
    gen(int,0,dx); { topstack point to operation area }    {生成int指令,分配dx個空間}
    statement( [semicolon,endsym]+fsys);    {調用語法分析程序}
    gen(opr,0,0); { return }    {生成0號gen程序,完成返回操做}
    test( fsys, [],8 );    {測試當前狀態是否合法,有問題報8號錯誤}
    listcode;    {列出該block所生成的PCODE}
end { block };

procedure interpret;  {解釋執行程序}
  const stacksize = 500;    {設置棧大小爲常量500}
  var p,b,t: integer; { program-,base-,topstack-register }    {設置三個寄存器,分別記錄下一條指令,基址地址和棧頂指針}
     i : instruction;{ instruction register }    {指令寄存器,類型爲instruction,顯然是爲了存放當前指令}
     s : array[1..stacksize] of integer; { data store }    {數據棧,大小爲stacksize=500個integer}
  function base( l : integer ): integer;    {聲明計算基地址的函數}
    var b1 : integer;    {聲明計數變量}
    begin { find base l levels down }    {目標是找到相對於如今層次之差爲l的層次基址}
      b1 := b;    {記錄當前層的基地址}
      while l > 0 do    {若是層數大於0,即尋找的不是本層}
        begin
          b1 := s[b1];    {記錄當前層數據基址的內容}
          l := l-1    {層數--}
        end;
      base := b1    {將找到的基地址保存起來}
    end; { base }
  begin  
    writeln( 'START PL/0' );    {輸出程序開始運行的提示語句}
    t := 0;    {將棧頂指針置零}
    b := 1;    {將基址地址置爲1}
    p := 0;    {將指令寄存器置零}
    s[1] := 0;    {將數據棧的第一層置零,對應SL}
    s[2] := 0;    {將數據棧的第二層置零,對應DL}
    s[3] := 0;    {將數據棧的第三層置零,對應RA}
    repeat    {循環開始}
      i := code[p];    {獲取當前須要執行的代碼}
      p := p+1;        {將指令寄存器+1,以指向下一條置零}
      with i do    {針對當前指令}
        case f of    {不一樣類型的指令執行不一樣操做}
          lit : begin    {對lit類型}
                  t := t+1;    {棧頂指針加1}
                  s[t]:= a;    {將a操做數的值放入棧頂}
              end;
          opr : case a of { operator }    {針對opr類型的指令}
                  0 : begin { return }    {0對應return操做}
                        t := b-1;    {t取到該層數據棧SL-1的位置,意味着將該層的數據棧所有清空(由於要返回了嘛)}
                        p := s[t+3];    {將指令指針指向RA的值,即得到return address}
                        b := s[t+2];    {將基址指針指向DL的值,即得到了return以後的基址,由於被調用層次的DL指向調用層次的基址}
                     end;
                  1 : s[t] := -s[t];    {1對應取反操做}
                  2 : begin        {2對應求和操做}
                        t := t-1;    {棧頂指針退一格}
                        s[t] := s[t]+s[t+1]    {將棧頂和次棧頂中的數值求和放入新的棧頂,注意運算後的棧頂是降低一格的,下面的運算亦如此}
                     end;
                  3 : begin        {3對應作差操做}
                        t := t-1;    {棧頂指針退格}
                        s[t] := s[t]-s[t+1]    {次棧頂減棧頂,結果放入新的棧頂}
                     end;
                  4 : begin        {4對應乘積操做}
                        t := t-1;    {棧頂退格}
                        s[t] := s[t]*s[t+1]    {棧頂和次棧頂相乘,結果放入新的棧頂}
                     end;
                  5 : begin        {5對應相除}
                        t := t-1;    {棧頂退格}
                        s[t] := s[t]div s[t+1]    {次棧頂除以棧頂,結果放入新的棧頂}
                     end;
                  6 : s[t] := ord(odd(s[t]));    {6對應判斷是否棧頂數值爲奇數}
                  8 : begin    {8號對應等值判斷}
                        t := t-1;    {棧頂退格}
                        s[t] := ord(s[t]=s[t+1])    {若是棧頂和次棧頂數值相同,棧頂置一,不然置零}
                    end;
                  9 : begin    {9號對應不等判斷}
                        t := t-1;    {棧頂退格}
                        s[t] := ord(s[t]<>s[t+1])    {若是棧頂和次棧頂數值不一樣,棧頂置一,不然置零}
                     end;
                  10: begin    {10號對應小於判斷}
                        t := t-1;    {棧頂退格}
                        s[t] := ord(s[t]< s[t+1])    {若是次棧頂的數值小於棧頂的數值,棧頂置一,不然置零}
                     end;
                  11: begin    {11號對應大於等於判斷}
                        t := t-1;    {棧頂退格}
                        s[t] := ord(s[t] >= s[t+1]) {若是次棧頂的數值大於等於棧頂的數值,棧頂置一,不然置零}
                     end;
                  12: begin    {12號對應着大於判斷}
                        t := t-1;    {棧頂退格}    
                        s[t] := ord(s[t] > s[t+1])    {若是次棧頂的數值大於棧頂的數值,棧頂置一,不然置零}
                     end;
                  13: begin    {13號對應着小於等於判斷}
                        t := t-1;    {棧頂退格}
                        s[t] := ord(s[t] <= s[t+1])    {若是次棧頂的數值小於等於棧頂的數值,棧頂置一,不然置零}
                     end;
                end;
          lod : begin    {若是是lod指令}
                  t := t+1;    {棧頂指針指向新棧}
                  s[t] := s[base(l)+a]    {將與當前數據層層次差爲l,層內偏移爲a的棧中的數據存到棧頂}
              end;
          sto : begin    {對於sto指令}
                  s[base(l)+a] := s[t];  { writeln(s[t]); }    {將當前棧頂的數據保存到與當前層層差爲l,層內偏移爲a的數據棧中}
                  t := t-1    {棧頂退棧}
              end;
          cal : begin  { generate new block mark }    {對於指令}
                  s[t+1] := base(l);    {因爲要生成新的block,所以棧頂壓入SL的值}
                  s[t+2] := b;    {在SL之上壓入當前數據區的基址,做爲DL}
                  s[t+3] := p;    {在DL之上壓入指令指針,便是指令的斷點,做爲RA}
                  b := t+1;    {把當前的數據區基址指向新的SL}
                  p := a;    {從a的位置繼續執行程序,a來自instruction結構體}
              end;
          int : t := t+a;    {對int指令,將棧頂指針上移a個位置}
          jmp : p := a;    {對jmp指令,將指令指針指向a}
          jpc : begin    {對於jpc指令}
                  if s[t] = 0    {若是棧頂數據爲零}
                  then p := a;    {則將指令指針指向a}
                  t := t-1;    {棧頂向下移動}
              end;
          red : begin    {對red指令}
                  writeln('??:');    {輸出提示信息}
                  readln(s[base(l)+a]); {讀一行數據,讀入到相差l層,層內偏移爲a的數據棧中的數據的信息}
              end;
          wrt : begin    {對wrt指令}
                  writeln(s[t]);    {輸出棧頂的信息}
                  t := t+1    {棧頂上移}
              end
        end { with,case }
    until p = 0;    {直到當前指令的指針爲0,這意味着主程序返回了,即整個程序已經結束運行了}
    writeln('END PL/0');    {PL/0執行結束}
  end; { interpret }

begin { main }    { 主函數 }
  writeln('please input source program file name : ');    {提示信息,要求用戶輸入源碼的地址}
  readln(sfile);    {讀入一行保存至sfile}
  assign(fin,sfile);    {將文件名字符串變量str付給文件變量fin}
  reset(fin);    {打開fin}
  for ch := 'A' to ';' do    
    ssym[ch] := nul;    {將從'A'到';'的符號的ssym都設置爲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;    {填寫保留字對應的標識符sym的值}

  ssym['+'] := plus;        ssym['-'] := minus;
  ssym['*'] := times;       ssym['/'] := slash;
  ssym['('] := lparen;      ssym[')'] := rparen;
  ssym['='] := eql;         ssym[','] := comma;
  ssym['.'] := period;
  ssym['<'] := lss;         ssym['>'] := gtr;
  ssym[';'] := semicolon;    {填寫對應符號對應的標識符sym的值}

  mnemonic[lit] := 'LIT  '; mnemonic[opr] := 'OPR  ';
  mnemonic[lod] := 'LOD  '; mnemonic[sto] := 'STO  ';
  mnemonic[cal] := 'CAL  '; mnemonic[int] := 'INT  ';
  mnemonic[jmp] := 'JMP  '; mnemonic[jpc] := 'JPC  ';
  mnemonic[red] := 'RED  '; mnemonic[wrt] := 'WRT  ';    {填寫助記符表,與PCODE指令一一對應}

  declbegsys := [ constsym, varsym, procsym ];    {表達式開始的符號集合}
  statbegsys := [ beginsym, callsym, ifsym, whilesym];    {語句開始的符號集合}
  facbegsys := [ ident, number, lparen ];    {項開始的符號集合}
  err := 0;    {將出錯的標識符置零}
  cc := 0;    {行緩衝指針置零}
  cx := 0;    {生成代碼行數計數置零}
  ll := 0;    {詞法分析行緩衝區長度置零}
  ch := ' ';    {當前字符設爲' '}
  kk := al;    {kk的值初始化爲0}
  getsym;    {獲取第一個詞的標識符}
  block( 0,0,[period]+declbegsys+statbegsys );    {執行主程序block}
  if sym <> period    {若是符號不是句號}
  then error(9);    {報⑨號錯誤}
  if err = 0    {若是err爲0表示沒有錯誤}
  then interpret    {開始解釋執行生成的PCODE代碼}
  else write('ERRORS IN PL/0 PROGRAM');    {不然出現了錯誤,報錯}
  writeln;    {換行}
  close(fin);    {關閉源文件程序}
  readln(sfile);    {讀取PL/0源程序}
end.           

 

Pascal-S編譯器

比PL0的代碼多很多，一樣是Pascal的子集，選擇重要函數註釋，未來有時間的話繼續補全

   1 program PASCALS(INPUT,OUTPUT,PRD,PRR);
   2 {  author:N.Wirth, E.T.H. CH-8092 Zurich,1.3.76 }
   3 {  modified by R.E.Berry
   4     Department of computer studies
   5     UniversitY of Lancaster
   6 
   7     Variants ot this program are used on
   8     Data General Nova,Apple,and
   9     Western Digital Microengine machines. }
  10 {   further modified by M.Z.Jin
  11     Department of Computer Science&Engineering BUAA,0ct.1989
  12 }
  13 {    comment by Song Lu
  14     Department of Computer Science&Engineering BUAA,Nov.2016
  15 }
  16 const nkw = 27;    { no. of key words }    {key word應當理解爲保留字}
  17       alng = 10;   { no. of significant chars in identifiers }
  18       llng = 121;  { input line length }
  19       emax = 322;  { max exponent of real numbers }
  20       emin = -292; { min exponent }
  21       kmax = 15;   { max no. of significant digits }
  22       tmax = 100;  { size of table }
  23       bmax = 20;   { size of block-talbe }
  24       amax = 30;   { size of array-table }
  25       c2max = 20;  { size of real constant table }
  26       csmax = 30;  { max no. of cases }
  27       cmax = 800;  { size of code }
  28       lmax = 7;    { maximum level }
  29       smax = 600;  { size of string-table }
  30       ermax = 58;  { max error no. }    {最大錯誤數量}
  31       omax = 63;   { highest order code }
  32       xmax = 32767;  { 2**15-1 }    {index的範圍}
  33       nmax = 32767;  { 2**15-1 }    {數字的範圍}
  34       lineleng = 132; { output line length }
  35       linelimit = 200;    {行數限制}
  36       stacksize = 1450;    {數據棧大小}
  37 type symbol = ( intcon, realcon, charcon, stringcon,
  38                 notsy, plus, minus, times, idiv, rdiv, imod, andsy, orsy,
  39                 eql, neq, gtr, geq, lss, leq,
  40                 lparent, rparent, lbrack, rbrack, comma, semicolon, period,
  41                 colon, becomes, constsy, typesy, varsy, funcsy,
  42                 procsy, arraysy, recordsy, programsy, ident,
  43                 beginsy, ifsy, casesy, repeatsy, whilesy, forsy,
  44                 endsy, elsesy, untilsy, ofsy, dosy, tosy, downtosy, thensy);
  45      index = -xmax..+xmax;
  46      alfa = packed array[1..alng]of char;
  47      objecttyp = (konstant, vvariable, typel, prozedure, funktion );
  48      types = (notyp, ints, reals, bools, chars, arrays, records );
  49      symset = set of symbol;
  50      typset = set of types;
  51      item = record
  52                typ: types;
  53                ref: index;
  54             end;
  55 
  56      order = packed record
  57                f: -omax..+omax;
  58                x: -lmax..+lmax;
  59                y: -nmax..+nmax
  60             end;
  61 var  ch:         char; { last character read from source program }
  62      rnum:       real; { real number from insymbol }
  63      inum:       integer;     { integer from insymbol }
  64      sleng:      integer;     { string length }
  65      cc:         integer;     { character counter }
  66      lc:         integer;     { program location counter }
  67      ll:         integer;     { length of current line }
  68      errpos:     integer;
  69      t,a,b,sx,c1,c2:integer;  { indices to tables }
  70      iflag, oflag, skipflag, stackdump, prtables: boolean;
  71      sy:         symbol;      { last symbol read by insymbol }
  72      errs:       set of 0..ermax;    {記錄錯誤的集合}
  73      id:         alfa;        { identifier from insymbol }
  74      progname:   alfa;
  75      stantyps:   typset;
  76      constbegsys, typebegsys, blockbegsys, facbegsys, statbegsys: symset;
  77      line:       array[1..llng] of char;
  78      key:        array[1..nkw] of alfa;        {保留字集合}
  79      ksy:        array[1..nkw] of symbol;    {保留字對應的sym集合}
  80      sps:        array[char]of symbol;  { special symbols }
  81      display:    array[0..lmax] of integer;
  82      tab:        array[0..tmax] of      { indentifier lable }    {符號表}
  83                  packed record
  84                      name: alfa;
  85                      link: index;
  86                      obj:  objecttyp;
  87                      typ:  types;
  88                      ref:  index;
  89                      normal: boolean;
  90                      lev:  0..lmax;
  91                      adr: integer
  92                  end;
  93      atab:       array[1..amax] of    { array-table }    {數組信息向量表}
  94                  packed record
  95                      inxtyp,eltyp: types;
  96                      elref,low,high,elsize,size: index
  97                  end;
  98      btab:       array[1..bmax] of    { block-table }    {分符號表}
  99                  packed record
 100                      last, lastpar, psize, vsize: index
 101                  end;
 102      stab:       packed array[0..smax] of char; { string table }    {字符串常量表}
 103      rconst:     array[1..c2max] of real;    {實常量表}
 104      code:       array[0..cmax] of order;    {P代碼表}
 105      psin,psout,prr,prd:text;      { default in pascal p }    {寫入inf,outf,fppr文件的文本}
 106      inf, outf, fprr: string;    {代碼輸入,代碼輸出,結果輸出的文件路徑}
 107 
 108 procedure errormsg;    {打印錯誤信息摘要的過程}
 109   var k : integer;
 110      msg: array[0..ermax] of alfa;    {給定錯誤信息表,最多ermax種錯誤}
 111   begin
 112     msg[0] := 'undef id  ';    msg[1] := 'multi def ';    {給定錯誤類型'k',及其提示信息}
 113     msg[2] := 'identifier';    msg[3] := 'program   ';
 114     msg[4] := ')         ';    msg[5] := ':         ';
 115     msg[6] := 'syntax    ';    msg[7] := 'ident,var ';
 116     msg[8] := 'of        ';    msg[9] := '(         ';
 117     msg[10] := 'id,array  ';    msg[11] := '(         ';
 118     msg[12] := ']         ';    msg[13] := '..        ';
 119     msg[14] := ';         ';    msg[15] := 'func. type';
 120     msg[16] := '=         ';    msg[17] := 'boolean   ';
 121     msg[18] := 'convar typ';    msg[19] := 'type      ';
 122     msg[20] := 'prog.param';    msg[21] := 'too big   ';
 123     msg[22] := '.         ';    msg[23] := 'type(case)';
 124     msg[24] := 'character ';    msg[25] := 'const id  ';
 125     msg[26] := 'index type';    msg[27] := 'indexbound';
 126     msg[28] := 'no array  ';    msg[29] := 'type id   ';
 127     msg[30] := 'undef type';    msg[31] := 'no record ';
 128     msg[32] := 'boole type';    msg[33] := 'arith type';
 129     msg[34] := 'integer   ';    msg[35] := 'types     ';
 130     msg[36] := 'param type';    msg[37] := 'variab id ';
 131     msg[38] := 'string    ';    msg[39] := 'no.of pars';
 132     msg[40] := 'real numbr';    msg[41] := 'type      ';
 133     msg[42] := 'real type ';    msg[43] := 'integer   ';
 134     msg[44] := 'var,const ';    msg[45] := 'var,proc  ';
 135     msg[46] := 'types(:=) ';    msg[47] := 'typ(case) ';
 136     msg[48] := 'type      ';    msg[49] := 'store ovfl';
 137     msg[50] := 'constant  ';    msg[51] := ':=        ';
 138     msg[52] := 'then      ';    msg[53] := 'until     ';
 139     msg[54] := 'do        ';    msg[55] := 'to downto ';
 140     msg[56] := 'begin     ';    msg[57] := 'end       ';
 141     msg[58] := 'factor';
 142 
 143     writeln(psout);    {向文件中打印一個空行}
 144     writeln(psout,'key words');    {向psout文件中輸出'key words',並換行}
 145     k := 0;
 146     while errs <> [] do    {若是還有錯誤信息沒有處理}
 147       begin
 148         while not( k in errs )do k := k + 1;    {若是不存在第k種錯誤,則判斷是否存在地k+1中}
 149         writeln(psout, k, ' ', msg[k] );    {在文件中輸出錯誤的編號及其信息}
 150         errs := errs - [k]    {將錯誤集合中的該類錯誤去除(由於已經處理過)}
 151     end { while errs }    {循環直到全部錯誤被處理}
 152   end { errormsg } ;
 153 
 154 procedure endskip;    {源程序出錯後再整個跳過部分代碼下面畫下劃線}
 155   begin                 { underline skipped part of input }
 156     while errpos < cc do
 157       begin
 158         write( psout, '-');
 159         errpos := errpos + 1
 160       end;
 161     skipflag := false
 162   end { endskip };
 163 
 164 
 165 procedure nextch;  { read next character; process line end }
 166   begin
 167     if cc = ll    {若是讀到了一行的末尾}
 168     then begin
 169            if eof( psin )    {文件讀完了}
 170            then begin
 171                   writeln( psout );    {寫輸出文件}
 172                   writeln( psout, 'program incomplete' );    {提示信息}
 173                   errormsg;    {輸出錯誤提示信息到list文件}
 174                   exit;
 175                 end;
 176            if errpos <> 0    {說明有錯誤,開始錯誤處理}
 177            then begin
 178                   if skipflag then endskip;    {跳過錯誤代碼}
 179                   writeln( psout );
 180                   errpos := 0
 181                 end;
 182            write( psout, lc: 5, ' ');    {沒有錯誤執行的操做,在list文件中輸出當前PCODE的行數以及一個空格,不換行}
 183            ll := 0;    {將行長度和行指針置零}
 184            cc := 0;
 185            while not eoln( psin ) do    {若是文件沒有讀完,讀下一行}
 186              begin
 187                ll := ll + 1;    {統計行的長度}
 188                read( psin, ch );    {讀取下一個字符}
 189                write( psout, ch );    {輸出到list文件中}
 190                line[ll] := ch    {將ch保存到line中,循環結束line保存下一行代碼的全部信息}
 191              end;
 192            ll := ll + 1;
 193            readln( psin );
 194            line[ll] := ' ';    {一行的末尾置爲空格}
 195            writeln( psout );
 196          end;
 197      cc := cc + 1;    {行指針前移}
 198      ch := line[cc];    {取詞}
 199   end { nextch };
 200 
 201 procedure error( n: integer );    {打印出錯位置和出錯編號}
 202 begin
 203   if errpos = 0
 204   then write ( psout, '****' );
 205   if cc > errpos
 206   then begin
 207          write( psout, ' ': cc-errpos, '^', n:2);
 208          errpos := cc + 3;
 209          errs := errs +[n]
 210       end
 211 end { error };
 212 
 213 procedure fatal( n: integer );    {打印表格溢出信息,寫入數據多於表大小時會終止程序}
 214   var msg : array[1..7] of alfa;
 215   begin
 216     writeln( psout );
 217     errormsg;
 218     msg[1] := 'identifier';   msg[2] := 'procedures';
 219     msg[3] := 'reals     ';   msg[4] := 'arrays    ';
 220     msg[5] := 'levels    ';   msg[6] := 'code      ';
 221     msg[7] := 'strings   ';
 222     writeln( psout, 'compiler table for ', msg[n], ' is too small');
 223     exit; {terminate compilation }
 224   end { fatal };
 225 
 226 procedure insymbol;  {reads next symbol}    {取符號方法}
 227 label 1,2,3;    {定義label,爲goto的使用作準備}
 228   var  i,j,k,e: integer;    
 229   procedure readscale;    {處理實數的指數部分}
 230     var s,sign: integer;
 231     begin
 232       nextch;
 233       sign := 1;    {符號}
 234       s := 0;        {數字}
 235       if ch = '+'    {若是讀到'+',不做處理}
 236       then nextch
 237       else if ch = '-'    {若是是'-',符號設爲負}
 238            then begin
 239                   nextch;
 240                   sign := -1
 241                 end;
 242       if not(( ch >= '0' )and (ch <= '9' ))    {若是符號後面跟的不是數字,報錯}
 243       then error( 40 )
 244       else repeat
 245            s := 10*s + ord( ord(ch)-ord('0'));    {把數字存到s中}
 246            nextch;
 247           until not(( ch >= '0' ) and ( ch <= '9' ));
 248       e := s*sign + e    {和下面計算中的e結合獲得真的e}
 249     end { readscale };
 250 
 251   procedure adjustscale;    {根據小數位數和指數大小求出數字數值的大小}
 252     var s : integer;
 253         d, t : real;
 254     begin
 255       if k + e > emax    {當前的位數加上指數若是超上限報錯}
 256       then error(21)
 257       else if k + e < emin    {小於最小值}
 258            then rnum := 0    {精度不夠了,直接記爲零}
 259       else begin
 260             s := abs(e);
 261             t := 1.0;
 262             d := 10.0;
 263             repeat
 264                 while not odd(s) do    {把偶次冪先用平方處理完}
 265                   begin
 266                     s := s div 2;
 267                     d := sqr(d)    {sqr表示平方}
 268                   end;
 269                 s := s - 1;
 270                 t := d * t    {在乘一下本身,完成1次,即將e分解爲2N+1或2N的形式}
 271             until s = 0;    {t此時爲10的e次方}
 272             if e >= 0    
 273             then rnum := rnum * t    {e大於零就乘10的e次方}
 274             else rnum := rnum / t    {反之除}
 275            end
 276      end { adjustscale };
 277 
 278   procedure options;    {編譯選項}
 279     procedure switch( var b: boolean );    {處理編譯選項中的'+''-'號}
 280       begin
 281         b := ch = '+';    {判斷當前符號是否爲'+'並存入b中返回,注意pascal中變量形參傳的是地址}
 282         if not b    {若是不是加號}
 283         then if not( ch = '-' )    {若是也不是減號}
 284              then begin { print error message }    {輸出錯誤信息}
 285                     while( ch <> '*' ) and ( ch <> ',' ) do    {跳過無用符號}
 286                       nextch;
 287                   end
 288              else nextch
 289         else nextch
 290       end { switch };
 291     begin { options  }    {處理編譯選項}
 292       repeat
 293         nextch;
 294         if ch <> '*'    {編譯選項爲*$t+,s+*的形式}
 295         then begin
 296                if ch = 't'    {字母t表示與打印相關的操做}
 297                then begin
 298                       nextch;
 299                       switch( prtables )    {根據符號判斷是否打印表格}
 300                     end
 301                else if ch = 's'    {s表示卸出打印}
 302                   then begin
 303                           nextch;
 304                           switch( stackdump )    
 305                        end;
 306              end
 307       until ch <> ','
 308     end { options };
 309   begin { insymbol  }
 310   1: while( ch = ' ' ) or ( ch = chr(9) ) do    {第一個flag立起來了! chr能夠得到9號字符,即跳過全部的空格和\t}
 311        nextch;    { space & htab }
 312     case ch of
 313       'a','b','c','d','e','f','g','h','i',
 314       'j','k','l','m','n','o','p','q','r',
 315       's','t','u','v','w','x','y','z':
 316         begin { identifier of wordsymbol }    {若是是字母,開始識別單詞}
 317           k := 0;
 318           id := '          ';
 319           repeat
 320             if k < alng    {alng是限定的關鍵詞長度}
 321             then begin
 322                    k := k + 1;
 323                    id[k] := ch
 324                  end;
 325             nextch
 326           until not((( ch >= 'a' ) and ( ch <= 'z' )) or (( ch >= '0') and (ch <= '9' )));
 327           i := 1;
 328           j := nkw; { binary search }    {二分查表,找到當前id在表中的位置}
 329           repeat
 330             k := ( i + j ) div 2;
 331             if id <= key[k]
 332             then j := k - 1;
 333             if id >= key[k]
 334             then i := k + 1;
 335           until i > j;
 336           if i - 1 > j
 337           then sy := ksy[k]    {獲取當前ID對應的sym}
 338           else sy := ident    {沒有找到即爲標識符}
 339         end;
 340       '0','1','2','3','4','5','6','7','8','9':    {數字開始當作數字識別}
 341         begin { number }
 342           k := 0;
 343           inum := 0;
 344           sy := intcon;    {sy設爲intcon表示數字}
 345           repeat
 346             inum := inum * 10 + ord(ch) - ord('0');    {把整數部分讀完,存到inum}
 347             k := k + 1;    {k統計當前數字位數}
 348             nextch
 349           until not (( ch >= '0' ) and ( ch <= '9' ));    
 350           if( k > kmax ) or ( inum > nmax )    {超上限報錯}
 351           then begin
 352                  error(21);
 353                  inum := 0;
 354                  k := 0
 355                end;
 356           if ch = '.'    {開始讀小數}
 357           then begin
 358                  nextch;
 359                  if ch = '.'
 360                  then ch := ':'
 361                  else begin
 362                         sy := realcon;    {sym爲實數}
 363                         rnum := inum;    {rnum存實數的值}
 364                         e := 0;    {指數}
 365                         while ( ch >= '0' ) and ( ch <= '9' ) do    {把數字讀完}
 366                           begin
 367                             e := e - 1;
 368                             rnum := 10.0 * rnum + (ord(ch) - ord('0'));    {暫時當作整數存}
 369                             nextch
 370                           end;
 371                         if e = 0    {小數點後沒數字,40號error}
 372                         then error(40);
 373                         if ch = 'e'    {若是是科學計數法}
 374                         then readscale;    {算e}
 375                         if e <> 0 then adjustscale    {算數,rnum存數}
 376                       end
 377                 end
 378           else if ch = 'e'
 379                then begin
 380                       sy := realcon;
 381                       rnum := inum;
 382                       e := 0;
 383                       readscale;
 384                       if e <> 0
 385                       then adjustscale
 386                     end;
 387         end;
 388       ':':
 389         begin
 390           nextch;
 391           if ch = '='
 392           then begin
 393                  sy := becomes;
 394                  nextch
 395                end
 396           else  sy := colon
 397          end;
 398       '<':
 399         begin
 400           nextch;
 401           if ch = '='
 402           then begin
 403                  sy := leq;
 404                  nextch
 405                end
 406           else
 407             if ch = '>'
 408             then begin
 409                    sy := neq;
 410                    nextch
 411                  end
 412             else  sy := lss
 413         end;
 414       '>':
 415         begin
 416           nextch;
 417           if ch = '='
 418           then begin
 419                  sy := geq;
 420                  nextch
 421                end
 422           else  sy := gtr
 423         end;
 424       '.':
 425         begin
 426           nextch;
 427           if ch = '.'
 428           then begin
 429                  sy := colon;    {..竟然算做colon冒號}
 430                  nextch
 431                end
 432           else sy := period
 433         end;
 434       '''':    {當前字符是否單引號}
 435         begin
 436           k := 0;
 437    2:     nextch;
 438           if ch = ''''
 439           then begin
 440                  nextch;
 441                  if ch <> ''''
 442                  then goto 3
 443                end;
 444           if sx + k = smax
 445           then fatal(7);
 446           stab[sx+k] := ch;
 447           k := k + 1;
 448           if cc = 1
 449           then begin { end of line }
 450                  k := 0;
 451                end
 452           else goto 2;
 453    3:     if k = 1    {雙引號中間只有一個字符}
 454           then begin
 455                  sy := charcon;    {sym類型爲字符類型}
 456                  inum := ord( stab[sx] )    {inum存儲該字符的ascii碼值}
 457                end
 458           else if k = 0    {空引號,中間沒東西}
 459                then begin
 460                       error(38);    {報錯}
 461                       sy := charcon;    {類型字符常量}
 462                       inum := 0    {asc爲0}
 463                     end
 464           else begin
 465                   sy := stringcon;    {不然就是一個字符串類型}
 466                   inum := sx;
 467                   sleng := k;
 468                   sx := sx + k
 469                end
 470         end;
 471       '(':
 472         begin
 473           nextch;
 474           if ch <> '*'
 475           then sy := lparent
 476           else begin { comment }
 477                  nextch;
 478                  if ch = '$'
 479                  then options;
 480                  repeat
 481                    while ch <> '*' do nextch;
 482                    nextch
 483                  until ch = ')';
 484                  nextch;
 485                  goto 1
 486                end
 487         end;
 488       '{':
 489         begin
 490           nextch;
 491           if ch = '$'    {左括號加$是進行編譯選項的設置}
 492           then options;
 493           while ch <> '}' do
 494             nextch;
 495           nextch;
 496           goto 1
 497         end;
 498       '+', '-', '*', '/', ')', '=', ',', '[', ']', ';':    {操做符直接處理}
 499         begin
 500           sy := sps[ch];
 501           nextch
 502         end;
 503       '$','"' ,'@', '?', '&', '^', '!':    {單獨出現算錯}
 504         begin
 505           error(24);
 506           nextch;
 507           goto 1
 508         end
 509       end { case }
 510     end { insymbol };
 511 
 512 procedure enter(x0:alfa; x1:objecttyp; x2:types; x3:integer );    {將當前符號(分程序外的)錄入符號表}
 513   begin
 514     t := t + 1;    { enter standard identifier }
 515     with tab[t] do
 516       begin
 517         name := x0;
 518         link := t - 1;
 519         obj := x1;
 520         typ := x2;
 521         ref := 0;
 522         normal := true;
 523         lev := 0;
 524         adr := x3;
 525       end
 526   end; { enter }
 527 
 528 procedure enterarray( tp: types; l,h: integer );    {將數組信息錄入數組表atab}
 529   begin
 530     if l > h    {下界大於上界,錯誤}
 531     then error(27);
 532     if( abs(l) > xmax ) or ( abs(h) > xmax )
 533     then begin
 534            error(27);
 535            l := 0;
 536            h := 0;
 537          end;
 538     if a = amax    {表滿了}
 539     then fatal(4)    
 540     else begin
 541            a := a + 1;
 542            with atab[a] do
 543              begin
 544                inxtyp := tp;    {下標類型}
 545                low := l;    {上界和下界}
 546                high := h
 547              end
 548          end
 549   end { enterarray };
 550 
 551 procedure enterblock;    {將分程序登陸到分程序表}
 552   begin
 553     if b = bmax    {表滿了}
 554     then fatal(2)    {報錯退出}
 555     else begin
 556            b := b + 1;
 557            btab[b].last := 0;        {指向過程或函數最後一個符號在表中的位置,建表用}
 558            btab[b].lastpar := 0;    {指向過程或者函數的最後一個'參數'符號在tab中的位置,退棧用}
 559          end
 560   end { enterblock };
 561 
 562 procedure enterreal( x: real );    {登錄實常量表}
 563   begin
 564     if c2 = c2max - 1
 565     then fatal(3)
 566     else begin
 567            rconst[c2+1] := x;
 568            c1 := 1;
 569            while rconst[c1] <> x do
 570              c1 := c1 + 1;
 571            if c1 > c2
 572            then  c2 := c1
 573          end
 574   end { enterreal };
 575 
 576 procedure emit( fct: integer );    {emit和下面兩個方法都是用來生成PCODE的,後面接的數字是表明有幾個操做數}
 577   begin
 578     if lc = cmax
 579     then fatal(6);
 580     code[lc].f := fct; 
 581     lc := lc + 1
 582 end { emit };
 583 
 584 
 585 procedure emit1( fct, b: integer );
 586   begin
 587     if lc = cmax
 588     then fatal(6);
 589     with code[lc] do
 590       begin
 591         f := fct;
 592         y := b;
 593       end;
 594     lc := lc + 1
 595   end { emit1 };
 596 
 597 procedure emit2( fct, a, b: integer );
 598   begin
 599     if lc = cmax then fatal(6);
 600     with code[lc] do
 601       begin
 602         f := fct;
 603         x := a;
 604         y := b
 605       end;
 606     lc := lc + 1;
 607 end { emit2 };
 608 
 609 procedure printtables;    {打印表的過程}
 610   var i: integer;
 611   o: order;
 612       mne: array[0..omax] of
 613            packed array[1..5] of char;
 614   begin
 615     mne[0] := 'LDA  ';   mne[1] := 'LOD  ';  mne[2] := 'LDI  ';    {定義PCODE指令符}
 616     mne[3] := 'DIS  ';   mne[8] := 'FCT  ';  mne[9] := 'INT  ';
 617     mne[10] := 'JMP  ';   mne[11] := 'JPC  ';  mne[12] := 'SWT  ';
 618     mne[13] := 'CAS  ';   mne[14] := 'F1U  ';  mne[15] := 'F2U  ';
 619     mne[16] := 'F1D  ';   mne[17] := 'F2D  ';  mne[18] := 'MKS  ';
 620     mne[19] := 'CAL  ';   mne[20] := 'IDX  ';  mne[21] := 'IXX  ';
 621     mne[22] := 'LDB  ';   mne[23] := 'CPB  ';  mne[24] := 'LDC  ';
 622     mne[25] := 'LDR  ';   mne[26] := 'FLT  ';  mne[27] := 'RED  ';
 623     mne[28] := 'WRS  ';   mne[29] := 'WRW  ';  mne[30] := 'WRU  ';
 624     mne[31] := 'HLT  ';   mne[32] := 'EXP  ';  mne[33] := 'EXF  ';
 625     mne[34] := 'LDT  ';   mne[35] := 'NOT  ';  mne[36] := 'MUS  ';
 626     mne[37] := 'WRR  ';   mne[38] := 'STO  ';  mne[39] := 'EQR  ';
 627     mne[40] := 'NER  ';   mne[41] := 'LSR  ';  mne[42] := 'LER  ';
 628     mne[43] := 'GTR  ';   mne[44] := 'GER  ';  mne[45] := 'EQL  ';
 629     mne[46] := 'NEQ  ';   mne[47] := 'LSS  ';  mne[48] := 'LEQ  ';
 630     mne[49] := 'GRT  ';   mne[50] := 'GEQ  ';  mne[51] := 'ORR  ';
 631     mne[52] := 'ADD  ';   mne[53] := 'SUB  ';  mne[54] := 'ADR  ';
 632     mne[55] := 'SUR  ';   mne[56] := 'AND  ';  mne[57] := 'MUL  ';
 633     mne[58] := 'DIV  ';   mne[59] := 'MOD  ';  mne[60] := 'MUR  ';
 634     mne[61] := 'DIR  ';   mne[62] := 'RDL  ';  mne[63] := 'WRL  ';
 635 
 636     writeln(psout);
 637     writeln(psout);
 638     writeln(psout);
 639     writeln(psout,'   identifiers  link  obj  typ  ref  nrm  lev  adr');
 640     writeln(psout);
 641     for i := btab[1].last to t do    {}
 642       with tab[i] do
 643         writeln( psout, i,' ', name, link:5, ord(obj):5, ord(typ):5,ref:5, ord(normal):5,lev:5,adr:5);
 644     writeln( psout );
 645     writeln( psout );
 646     writeln( psout );
 647     writeln( psout, 'blocks   last  lpar  psze  vsze' );
 648     writeln( psout );
 649     for i := 1 to b do
 650        with btab[i] do
 651          writeln( psout, i:4, last:9, lastpar:5, psize:5, vsize:5 );
 652     writeln( psout );
 653     writeln( psout );
 654     writeln( psout );
 655     writeln( psout, 'arrays xtyp etyp eref low high elsz size');
 656     writeln( psout );
 657     for i := 1 to a do
 658       with atab[i] do
 659         writeln( psout, i:4, ord(inxtyp):9, ord(eltyp):5, elref:5, low:5, high:5, elsize:5, size:5);
 660     writeln( psout );
 661     writeln( psout );
 662     writeln( psout );
 663     writeln( psout, 'code:');
 664     writeln( psout );
 665     for i := 0 to lc-1 do
 666       begin
 667         write( psout, i:5 );
 668         o := code[i];
 669         write( psout, mne[o.f]:8, o.f:5 );
 670         if o.f < 31
 671         then if o.f < 4
 672              then write( psout, o.x:5, o.y:5 )
 673              else write( psout, o.y:10 )
 674         else write( psout, '          ' );
 675         writeln( psout, ',' )
 676       end;
 677     writeln( psout );
 678     writeln( psout, 'Starting address is ', tab[btab[1].last].adr:5 )
 679   end { printtables };
 680 
 681 
 682 procedure block( fsys: symset; isfun: boolean; level: integer );    {程序分析過程}
 683   type conrec = record    {這種結構體能夠根據不一樣的type類型來保存不一樣樣式的數據}
 684                   case tp: types of
 685                     ints, chars, bools : ( i:integer );
 686                     reals :( r:real )
 687               end;
 688   var dx : integer ;  { data allocation index }
 689       prt: integer ;  { t-index of this procedure }
 690       prb: integer ;  { b-index of this procedure }
 691       x  : integer ;
 692 
 693 
 694   procedure skip( fsys:symset; n:integer);    {跳過錯誤的代碼段}
 695     begin
 696       error(n);
 697       skipflag := true;
 698       while not ( sy in fsys ) do
 699         insymbol;
 700       if skipflag then endskip
 701     end { skip };
 702 
 703   procedure test( s1,s2: symset; n:integer );    {檢查當前sym是否合法}
 704     begin
 705       if not( sy in s1 )
 706       then skip( s1 + s2, n )
 707     end { test };
 708 
 709   procedure testsemicolon;    {檢查分號是否合法}
 710     begin
 711       if sy = semicolon
 712       then insymbol
 713       else begin
 714              error(14);
 715              if sy in [comma, colon]
 716              then insymbol
 717            end;
 718       test( [ident] + blockbegsys, fsys, 6 )
 719     end { testsemicolon };
 720 
 721 
 722   procedure enter( id: alfa; k:objecttyp );    {將分程序中的某一符號入符號表}
 723     var j,l : integer;
 724     begin
 725       if t = tmax    {表滿了報錯退出}
 726       then fatal(1)
 727       else begin
 728              tab[0].name := id;    
 729              j := btab[display[level]].last;    {獲取指向當前層最後一個標識符在tab表中的位置}    
 730              l := j;    
 731              while tab[j].name <> id do    
 732                j := tab[j].link;
 733              if j <> 0    {j不等於0說明此符號已經在符號表中出現過,報1號錯誤,意味着重複定義了}
 734              then error(1)
 735              else begin    {沒重複定義就正常入棧}
 736                     t := t + 1;
 737                     with tab[t] do    {將符號放入符號表,注意這裏並無給定符號的typ,ref和adr,這三個變量在procedure typ中被處理}
 738                       begin
 739                         name := id;    {輸入參數之一,符號的名字}
 740                         link := l;
 741                         obj := k;    {輸入參數之一,符號表明的目標種類(大類)}
 742                         typ := notyp;
 743                         ref := 0;
 744                         lev := level;
 745                         adr := 0;
 746                         normal := false { initial value }
 747                       end;
 748                     btab[display[level]].last := t    {更新當前層最後一個標識符}
 749                   end
 750            end
 751     end { enter };
 752 
 753   function loc( id: alfa ):integer;    {查找id在符號表中的位置}
 754     var i,j : integer;        { locate if in table }
 755     begin
 756       i := level;
 757       tab[0].name := id;  { sentinel }
 758       repeat
 759         j := btab[display[i]].last;
 760         while tab[j].name <> id do
 761           j := tab[j].link;
 762         i := i - 1;
 763       until ( i < 0 ) or ( j <> 0 );
 764       if j = 0    {符號沒找到,說明以前沒聲明,報0號錯誤}
 765       then error(0);
 766       loc := j
 767     end { loc } ;
 768 
 769   procedure entervariable;    {變量登錄符號表的過程}
 770     begin
 771       if sy = ident
 772       then begin
 773              enter( id, vvariable );
 774              insymbol
 775            end
 776       else error(2)
 777     end { entervariable };
 778 
 779   procedure constant( fsys: symset; var c: conrec );    {處理程序中出現的常量,變量c負責返回該常量的類型和值}
 780     var x, sign : integer;
 781     begin
 782       c.tp := notyp;
 783       c.i := 0;
 784       test( constbegsys, fsys, 50 );
 785       if sy in constbegsys    {若是第一個sym是常量開始的符號,才往下繼續分析}
 786       then begin    {根據不一樣的符號執行不一樣的操做,目的就是返回正確的c}
 787              if sy = charcon    {對字符常量}
 788              then begin
 789                     c.tp := chars;    {類型是char}
 790                     c.i := inum;    {inum存儲該字符的ascii碼值}
 791                     insymbol    {獲取下一個sym}
 792                   end
 793              else begin
 794                   sign := 1;    {不是符號常量}
 795                   if sy in [plus, minus]
 796                   then begin
 797                          if sy = minus    
 798                          then sign := -1;    {負號變符號}
 799                          insymbol
 800                        end;
 801                   if sy = ident    {遇到了標識符}
 802                   then begin
 803                          x := loc(id);    {找到當前id在表中的位置}
 804                          if x <> 0    {找到了}
 805                          then
 806                            if tab[x].obj <> konstant    {若是id對應的符號種類不是常量,報錯}
 807                            then error(25)
 808                            else begin
 809                                   c.tp := tab[x].typ;    {得到常量類型}
 810                                   if c.tp = reals    {對實數和整數採起不一樣的賦值方法}
 811                                   then c.r := sign*rconst[tab[x].adr]
 812                                   else c.i := sign*tab[x].adr
 813                                 end;
 814                          insymbol
 815                        end
 816                   else if sy = intcon    {遇到整數}
 817                        then begin
 818                               c.tp := ints;    {存type存值}
 819                               c.i := sign*inum;
 820                               insymbol
 821                             end
 822                   else if sy = realcon    {遇到實數}
 823                         then begin
 824                                c.tp := reals;
 825                                c.r := sign*rnum;
 826                                insymbol
 827                              end
 828                   else skip(fsys,50)    {跳過無用符號}
 829                 end;
 830                 test(fsys,[],6)
 831            end
 832     end { constant };
 833 
 834 procedure typ( fsys: symset; var tp: types; var rf,sz:integer );    {處理類型說明,返回當前關鍵詞的類型,在符號表中的位置,以及須要佔用存儲空間的大小}
 835     var eltp : types;    {元素類型}
 836         elrf, x : integer;    
 837         elsz, offset, t0, t1 : integer;
 838 
 839     procedure arraytyp( var aref, arsz: integer );    {處理數組類型的子過程}
 840       var eltp : types;        {記錄元素的類型,pascal中一個數組的全部元素的類型必須相同}
 841          low, high : conrec;    {記錄數組編號(index)的上下界}
 842          elrf, elsz: integer;    {記錄ref和size方便返回}
 843       begin
 844         constant( [colon, rbrack, rparent, ofsy] + fsys, low );    {得到數組編號的下界}
 845         if low.tp = reals    {若是下界類型爲實型}
 846         then begin
 847                error(27);    {報27號錯誤}
 848                low.tp := ints;    {類型爲整型}
 849                low.i := 0    {數值設爲0}
 850              end;
 851         if sy = colon    {下界後面跟'..',類型是colon,constant結束後讀入了下一個sym}
 852         then insymbol    {得到下一個sym}
 853         else error(13);    {若是後面跟的不是..,報13號錯誤}
 854         constant( [rbrack, comma, rparent, ofsy ] + fsys, high );    {獲取數組下表上界}
 855         if high.tp <> low.tp    {上下界類型不一樣報錯,也就是說上界也必須是整型}
 856         then begin
 857                error(27);    {報27號錯誤}
 858                high.i := low.i    {容錯,是使得上界等於下界}
 859              end;
 860         enterarray( low.tp, low.i, high.i );    {將數組的信息錄入到atab中}
 861         aref := a;    {獲取當前數組在atab中的位置}
 862         if sy = comma    {後面接逗號,說明須要創建多維數組}
 863         then begin
 864                insymbol;    {讀取下一個字符}
 865                eltp := arrays;    {數組中的每一個元素類型都是數組}
 866                arraytyp( elrf, elsz )    {遞歸調用arraytyp處理數組元素}
 867              end
 868         else begin
 869                if sy = rbrack    {遇到右中括號,則index部分聲明完畢}
 870                then insymbol    {獲取下一個sym}
 871                else begin
 872                       error(12);    {缺乏右中括號}
 873                       if sy = rparent    {若是是右括號}
 874                       then insymbol        {容錯}
 875                     end;
 876                if sy = ofsy        {獲取到了of關鍵字}
 877                then insymbol    {獲取下一個sym}
 878                else error(8);    {沒有of報8號錯}
 879                typ( fsys, eltp, elrf, elsz )    {處理當前的符號類型}
 880              end;
 881              with atab[aref] do    {記錄當前數組的信息}
 882                begin
 883                  arsz := (high-low+1) * elsz;    {計算該數組須要佔用的存儲空間}
 884                  size := arsz;    {記錄該數組須要佔用的存儲空間}
 885                  eltyp := eltp;    {記錄數組的元素類型}
 886                  elref := elrf;    {記錄數組在atab中登錄的位置}
 887                  elsize := elsz        {記錄每一個元素的大小}
 888                end
 889       end { arraytyp };
 890     begin { typ  }    {類型處理過程開始}
 891       tp := notyp;    {用以存儲變量的類型}
 892       rf := 0;    {用以記錄符號在符號表中的位置}
 893       sz := 0;    {用以儲存該類型的大小}
 894       test( typebegsys, fsys, 10 );    {測試當前符號是不是數組聲明的開始符號,若是不是則報10號錯誤}
 895       if sy in typebegsys    {若是是數組聲明的開始符號}
 896       then begin
 897              if sy = ident    {若是如今的符號是標識符}
 898              then begin
 899                     x := loc(id);    {查找id在符號表中的位置}
 900                     if x <> 0        {若是找到了}
 901                     then with tab[x] do    {對其對應表項進行操做}
 902                            if obj <> typel    {標識符的種類不是'種類'(typel)}
 903                            then error(29)    {報29號錯,由於聲明一個變量須要先標明其類型}
 904                            else begin
 905                                   tp := typ;    {得到其表明的類型(char,int,real..)}
 906                                   rf := ref;    {得到其在符號表中的位置}
 907                                   sz := adr;    {得到其在運行棧中分配的儲存單元的相對地址}
 908                                   if tp = notyp    {若是未定義類型}
 909                                   then error(30)    {報30號錯}
 910                                 end;
 911                     insymbol    {得到下一個sym}
 912                   end
 913              else if sy = arraysy    {若是遇到的是數組元素,即聲明開頭爲'array'}
 914                   then begin
 915                          insymbol;    {得到下一個sym}
 916                          if sy = lbrack    {數組元素聲明應該從左中括號開始,即代表數組的大小/維度}
 917                          then insymbol    {獲取下一個sym}
 918                          else begin    {若是不是左中括號開始}
 919                                 error(11);    {報11號錯誤,說明左括號發生錯誤}
 920                                 if sy = lparent    {若是找到了左括號,多是用戶輸入錯誤,報錯後作容錯處理}
 921                                 then insymbol    {獲取下一個sym}
 922                               end;
 923                          tp := arrays;    {當前類型設置爲數組類型}
 924                          arraytyp(rf,sz)    {得到數組在atab表中的登錄位置,和數組的大小}
 925                          end
 926              else begin { records }    {不然必定是record的類型,由於typebegsys中只包含ident,arraysy和recordsy三種類型}
 927                     insymbol;    {獲取下一個sym}
 928                     enterblock;    {登錄子程序}
 929                     tp := records;    {當前類型設置爲records類型}
 930                     rf := b;    {rf指向當前過程在block表中的位置}
 931                     if level = lmax    {若是當前嵌套層次已是最大層次了,即不能產生更深的嵌套}
 932                     then fatal(5);    {報5號嚴重錯誤並終止程序}
 933                     level := level + 1;    {若是還能嵌套,聲明程序成功,block的層次是當前層次+1}
 934                     display[level] := b;    {設置當前層次的display區.創建分層次索引}
 935                     offset := 0;
 936                     while not ( sy in fsys - [semicolon,comma,ident]+ [endsy] ) do    {end以前都是記錄類型變量內的變量聲明}
 937                       begin { field section }    {開始處理record內部的成員變量}
 938                         if sy = ident    {若是遇到的是標識符}
 939                         then begin
 940                                t0 := t;    {得到當前tab指針的位置}
 941                                entervariable;    {變量入表}
 942                                while sy = comma do    {同種變量之間經過逗號分隔,未遇到分號則繼續讀入}
 943                                  begin
 944                                    insymbol;    {得到下一個sym}
 945                                    entervariable    {繼續變量入表的過程}
 946                                  end;
 947                                if sy = colon    {遇到了冒號,說明這類的變量聲明結束了,冒號後面跟變量的類型}
 948                                then insymbol    {獲取sym}
 949                                else error(5);    {若是沒有遇到逗號或者冒號,則拋出5號錯誤}
 950                                t1 := t;        {記錄當前tab棧頂符號的位置,至此t0到t1的符號表中並無填寫typ,ref和adr}
 951                                typ( fsys + [semicolon, endsy, comma,ident], eltp, elrf,elsz );    {遞歸調用typ來處理記錄類型的成員變量,肯定各成員的類型,ref和adr(注意對於不一樣的類型,ref和adr可能表示不一樣的意義)}
 952                                while t0 < t1 do    {填寫t0到t1中信息缺失的部分,須要注意的是t0~t1都是同一類型的變量,所以size大小是相同的}
 953                                begin
 954                                  t0 := t0 + 1;    {指針上移}
 955                                  with tab[t0] do    {修改當前表項}
 956                                    begin
 957                                      typ := eltp;    {給typ賦值,eltp來之上面遞歸調用的typ語句}
 958                                      ref := elrf;    {給ref賦值}
 959                                      normal := true;    {給normal標記賦值,全部normal的初值都是false}
 960                                      adr := offset;    {記錄該變量相對於起始地址的位移}
 961                                      offset := offset + elsz    {得到下一變量的其實地址}
 962                                    end
 963                                end
 964                              end; { sy = ident }
 965                         if sy <> endsy    {遇到end說明成員聲明已經結束了}
 966                         then begin
 967                                if sy = semicolon    {end後面須要接分號}
 968                                then insymbol    {獲取下一個sym}
 969                                else begin    {若是接的不是分號}
 970                                       error(14);    {先報個錯}
 971                                       if sy = comma    {若是是逗號作容錯處理}
 972                                       then insymbol    {而後獲取下一個sym類型}
 973                                     end;
 974                                     test( [ident,endsy, semicolon],fsys,6 )    {檢驗當前符號是否合法}
 975                              end
 976                       end; { field section }
 977                     btab[rf].vsize := offset;    {offset存儲了當前的局部變量,參數以及display區所佔的空間總數,將其記錄下來}
 978                     sz := offset;    {儲存其佔用空間總數}
 979                     btab[rf].psize := 0;    {該程序塊的參數佔用空間設爲0,由於record類型並非真正的過程變量,沒有參數}
 980                     insymbol;    {後去下一個sym}
 981                     level := level - 1    {record聲明結束後退出當前層次}
 982                   end; { record }
 983              test( fsys, [],6 )    {檢查當前sym是否合法}
 984            end;
 985       end { typ };
 986 
 987   procedure parameterlist; { formal parameter list }    {處理過程或函數說明中的形參,將形參登錄到符號表}
 988     var tp : types;    {記錄類型}
 989         valpar : boolean;    {記錄當前參數是否爲值形參(valueparameter)}
 990         rf, sz, x, t0 : integer;
 991     begin
 992       insymbol;    {得到下一個sym}
 993       tp := notyp;    {初始化類型}
 994       rf := 0;    {初始化符號表位置}
 995       sz := 0;    {初始化元素大小}
 996       test( [ident, varsy], fsys+[rparent], 7 );    {檢驗當前符號是否合法}
 997       while sy in [ident, varsy] do    {若是當前的符號是標識符或者var關鍵字}
 998         begin
 999           if sy <> varsy    {若是是var關鍵字}
1000           then valpar := true    {將valpar標識符設置爲真}
1001           else begin
1002                  insymbol;    {若是不是標識符,獲取下一個sym}
1003                  valpar := false    {將valpar設置爲假}
1004                end;
1005           t0 := t;    {記錄當前符號表棧頂位置}
1006           entervariable;    {調用變量入表的子過程,將參數符號放入符號表}
1007           while sy = comma do    {若是識別到逗號,說明還有同類型的參數,繼續放入符號表}
1008             begin
1009               insymbol;    {獲取下一個sym}
1010               entervariable;    {將當前sym放入符號表}
1011             end;
1012           if sy = colon    {若是識別到冒號,開始處理類型}
1013           then begin
1014                  insymbol;    {獲取下一個sym,這裏應當是類型}
1015                  if sy <> ident    {若是不是標識符}
1016                  then error(2)    {報2號錯誤}
1017                  else begin
1018                         x := loc(id);    {若是是標識符,則尋找其在符號表中的位置}
1019                         insymbol;    {獲取下一個sym}
1020                         if x <> 0    {若是在符號表中找到了sym}
1021                         then with tab[x] do    {對當前表項作操做}
1022                           if obj <> typel    {若是當前的符號不是類型標識符}
1023                           then error(29)    {報29號錯誤}
1024                           else begin
1025                                  tp := typ;    {獲取參數的類型}
1026                                  rf := ref;    {獲取參數在當前符號表的位置}
1027                                  if valpar    {若是是值形參}
1028                                  then sz := adr    {sz得到當前形參在符號表中的位置}
1029                                  else sz := 1    {不然將sz置爲1}
1030                                end;
1031                       end;
1032                  test( [semicolon, rparent], [comma,ident]+fsys, 14 )    {檢驗當前符號是否合法,不合法報14號錯誤}
1033                  end
1034           else error(5);    {若是不是分號,報5號錯誤}
1035           while t0 < t do    {t0~t都是同一類型將上面處理的符號中的屬性填寫完整}
1036             begin
1037               t0 := t0 + 1;    {得到剛纔讀到的第一個參數}
1038               with tab[t0] do    {對當前符號表中的符號作操做}
1039                 begin
1040                   typ := tp;    {設置當前符號的類型}
1041                   ref := rf;    {設置當前符號在符號表中的位置}
1042                   adr := dx;    {設置形參的相對地址}
1043                   lev := level;    {設置形參的level}
1044                   normal := valpar;    {設置當前變量的normal標記}
1045                   dx := dx + sz    {更新位移量}
1046                 end
1047             end;
1048             if sy <> rparent    {若是聲明結束以後不是右括號}
1049             then begin
1050                    if sy = semicolon    {而是分號,說明還有須要聲明的參數}
1051                    then insymbol    {獲取下一個sym}
1052                    else begin
1053                           error(14);    {不然報14號錯誤}
1054                           if sy = comma    {若是是逗號,作容錯處理}
1055                           then insymbol    {接受下一個sym}
1056                         end;
1057                         test( [ident, varsy],[rparent]+fsys,6)    {檢查下面的符號是不是標識符或者變量聲明,均不是則報6號錯誤}
1058                  end
1059         end { while };
1060       if sy = rparent    {參數聲明結束後應當用右括號結尾}
1061       then begin
1062              insymbol;    {獲取下一個符號}
1063              test( [semicolon, colon],fsys,6 )    {聲明結束後用分號結束或使用冒號聲明返回值類型,若是不是這兩種符號,報6號錯誤}
1064            end
1065       else error(4)    {不是右括號結尾,報錯}
1066     end { parameterlist };
1067 
1068 
1069   procedure constdec;    {常量聲明的處理過程}
1070     var c : conrec;
1071     begin
1072       insymbol;    {獲取下一個sym}
1073       test([ident], blockbegsys, 2 );    {檢查是否是標識符}
1074       while sy = ident do    {當得到的是標誌符的是否作循環}
1075         begin
1076           enter(id, konstant);    {入表,類型爲konstant表示常量}
1077           insymbol;
1078           if sy = eql    {等號}
1079           then insymbol
1080           else begin
1081                  error(16);
1082                  if sy = becomes    {賦值符號容錯}
1083                  then insymbol
1084                end;
1085           constant([semicolon,comma,ident]+fsys,c);    {得到常量的類型和數值}
1086           tab[t].typ := c.tp;    {填表}
1087           tab[t].ref := 0;        {常量ref爲0}
1088           if c.tp = reals
1089           then begin    {實型和整型的操做不一樣}
1090                  enterreal(c.r);
1091                  tab[t].adr := c1;    {實常量的adr保存了其在rconst表中的登錄的位置}
1092               end
1093           else tab[t].adr := c.i;
1094           testsemicolon
1095         end
1096     end { constdec };
1097 
1098   procedure typedeclaration;    {處理類型聲明}
1099     var tp: types;
1100         rf, sz, t1 : integer;
1101     begin
1102       insymbol;
1103       test([ident], blockbegsys,2 );    {檢查獲取到的是否是標識符}
1104       while sy = ident do    {對因而標識符的狀況進行操做}
1105         begin
1106           enter(id, typel);    {類型的名稱的類型入表}
1107           t1 := t;        {得到符號表頂部指針}
1108           insymbol;    
1109           if sy = eql    {獲取等號}
1110           then insymbol
1111           else begin
1112                  error(16);
1113                  if sy = becomes    {賦值符號容錯}
1114                  then insymbol    
1115                end;
1116           typ( [semicolon,comma,ident]+fsys, tp,rf,sz );    {得到類型變量的類型,在符號表中的位置以及佔用空間的大小}
1117           with tab[t1] do    {將返回值填表}
1118             begin
1119               typ := tp;    
1120               ref := rf;
1121               adr := sz
1122             end;
1123           testsemicolon
1124         end
1125     end { typedeclaration };
1126 
1127   procedure variabledeclaration;    {處理變量聲明}
1128     var tp : types;
1129         t0, t1, rf, sz : integer;
1130     begin
1131       insymbol;
1132       while sy = ident do
1133         begin
1134           t0 := t;
1135           entervariable;
1136           while sy = comma do
1137             begin
1138               insymbol;
1139               entervariable;    {調用變量入表的程序}
1140             end;
1141           if sy = colon
1142           then insymbol
1143           else error(5);
1144           t1 := t;
1145           typ([semicolon,comma,ident]+fsys, tp,rf,sz );    {得到類型,地址和大小}
1146           while t0 < t1 do
1147             begin
1148               t0 := t0 + 1;
1149               with tab[t0] do    {填表}
1150                 begin
1151                   typ := tp;
1152                   ref := rf;
1153                   lev := level;
1154                   adr := dx;
1155                   normal := true;
1156                   dx := dx + sz
1157                 end
1158             end;
1159           testsemicolon
1160         end
1161     end { variabledeclaration };
1162 
1163   procedure procdeclaration;    {處理過程聲明}
1164     var isfun : boolean;
1165     begin
1166       isfun := sy = funcsy;
1167       insymbol;
1168       if sy <> ident
1169       then begin
1170              error(2);
1171              id :='          '
1172            end;
1173       if isfun    {函數和過程使用不一樣的kind類型}
1174       then enter(id,funktion)
1175       else enter(id,prozedure);
1176       tab[t].normal := true;
1177       insymbol;
1178       block([semicolon]+fsys, isfun, level+1 );    {過程的處理直接調用block}
1179       if sy = semicolon
1180       then insymbol
1181       else error(14);
1182       emit(32+ord(isfun)) {exit}    {推出過程/函數}
1183     end { proceduredeclaration };
1184 
1185 
1186 procedure statement( fsys:symset );
1187     var i : integer;
1188 
1189   procedure expression(fsys:symset; var x:item); forward;    {處理表達式的子程序,由x返回結果,forward使得selector能夠調用expression}
1190     procedure selector(fsys:symset; var v:item);    {處理結構變量:數組下標或記錄成員變量}
1191     var x : item;
1192         a,j : integer;
1193     begin { sy in [lparent, lbrack, period] }    {當前的符號應該是左括號,作分號或句號之一}
1194       repeat
1195         if sy = period    {若是當前的符號是句號,由於引用成員變量的方式爲'記錄名.成員名',所以識別到'.'以後應該開始處理後面的結構名稱}
1196         then begin
1197                insymbol; { field selector }    {處理成員變量}
1198                if sy <> ident    {若是獲取到的不是標識符}
1199                then error(2)    {報2號錯誤}
1200                else begin    
1201                       if v.typ <> records    {若是處理的不是記錄類型}
1202                       then error(31)    {報31號錯誤}
1203                       else begin { search field identifier }    {在符號表中尋找類型標識符}
1204                              j := btab[v.ref].last;        {得到該結構體在符號表中最後一個符號的位置}
1205                              tab[0].name := id;    {暫存當前符號的id}
1206                              while tab[j].name <> id do    {在符號表中尋找當前符號}
1207                                j := tab[j].link;    {沒對應上則繼續向前找}
1208                              if j = 0    {在當前層(記錄中)沒找到對應的符號,符號未聲明}
1209                              then error(0);    {報0號錯誤}
1210                              v.typ := tab[j].typ;    {找到了則獲取屬性}
1211                              v.ref := tab[j].ref;    {記錄其所在的btab位置}
1212                              a := tab[j].adr;    {記錄該成員變量相對於記錄變量起始地址的位移}
1213                              if a <> 0    {若是位移不爲零}
1214                              then emit1(9,a)    {生成一條指令來計算此位移}
1215                            end;
1216                       insymbol    {獲取下一個sym}
1217                     end
1218              end
1219         else begin { array selector }    {處理數組下表}
1220                if sy <> lbrack    {若是下表不是左括號開頭}
1221                then error(11);    {報11號錯誤}
1222                repeat    {循環,針對多維數組}
1223                  insymbol;    {獲取下一個sym}
1224                  expression( fsys+[comma,rbrack],x);    {遞歸調用處理表達式的過程處理數組下標,得到返回結果保存到x中}
1225                  if v.typ <> arrays    {若是傳入的類型不是數組}
1226                  then error(28)    {報22號錯誤}
1227                  else begin    
1228                         a := v.ref;    {得到該數組在atab中的位置}
1229                         if atab[a].inxtyp <> x.typ    {若是傳入的下標和數組規定的下標類型不符}
1230                         then error(26)    {報26號錯誤}
1231                         else if atab[a].elsize = 1    {若是是變量形參}
1232                              then emit1(20,a)    {進行尋址操做}
1233                         else emit1(21,a);    {對值形參也進行尋址操做}
1234                         v.typ := atab[a].eltyp;    {得到當前數組元素的類型}
1235                         v.ref := atab[a].elref    {得到數組元素在atab中的位置}
1236                       end
1237                until sy <> comma;    {若是讀到的不是逗號,說明沒有更高維的數組}
1238                if sy = rbrack    {若是讀到右中括號}
1239                then insymbol    {讀取下一個sym}
1240                else begin
1241                       error(12);    {沒讀到右中括號則報12號錯誤}
1242                       if sy = rparent    {若是讀到了右括號,作容錯處理}
1243                       then insymbol    {讀取下一個sym}
1244                    end
1245              end
1246       until not( sy in[lbrack, lparent, period]);    {循環直到全部子結構(數組下標或者記錄)都被識別完位置}
1247       test( fsys,[],6)    {檢測當前的符號是否合法}
1248     end { selector };
1249 
1250     procedure call( fsys: symset; i:integer );    {處理非標準過程和函數調用的方法,其中i表示須要調用的過程或函數名在符號表中的位置}
1251        var x : item;    
1252           lastp,cp,k : integer;
1253        begin
1254         emit1(18,i); { mark stack }    {生成標記棧指令,傳入被調用過程或函數在tab表中的位置,創建新的內務信息區}
1255         lastp := btab[tab[i].ref].lastpar;    {記錄當前過程或函數最後一個參數在符號表中的位置}
1256         cp := i;    {記錄被調用過程在符號表中的位置}
1257         if sy = lparent    {若是是識別到左括號}
1258         then begin { actual parameter list }    {開始處理參數}
1259                repeat    {開始循環}
1260                  insymbol;    {獲取參數的sym}
1261                  if cp >= lastp    {若是當前符號的位置小於最後一個符號的位置,說明還有參數沒有處理,反之是錯誤的}
1262                  then error(39)    {報39號錯誤}
1263                  else begin    {開始處理參數}
1264                         cp := cp + 1;    {將cp指針向上移動一格}
1265                         if tab[cp].normal    {若是normal的值爲真,即若是傳入的是值形參或者其餘參數}
1266                         then begin { value parameter }    {開始處理值形參}
1267                                expression( fsys+[comma, colon,rparent],x);    {遞歸調用處理表達式的過程處理參數}
1268                                if x.typ = tab[cp].typ    {若是參數的類型和符號表中規定的類型相同}
1269                                then begin
1270                                       if x.ref <> tab[cp].ref    {若是表達式指向的btab和符號表中所記錄的btab不一樣}
1271                                       then error(36)    {報36號錯誤}
1272                                       else if x.typ = arrays    {若是遇到了數組類型}
1273                                            then emit1(22,atab[x.ref].size)    {生成裝入塊指令,將實參表達式的值或地址放到預留的參數單元中}
1274                                       else if x.typ = records    {若是遇到了記錄類型}
1275                                            then emit1(22,btab[x.ref].vsize)    {一樣生成裝入塊指令完成操做,只是細節有所不一樣}
1276                                     end
1277                                else if ( x.typ = ints ) and ( tab[cp].typ = reals )    {若是表達式的類型是整型,可是要求是輸入的是實型參數}
1278                                     then emit1(26,0)    {生成26號指令,進行類型轉換}
1279                                else if x.typ <> notyp    {若是沒有獲取到表達式的類型}
1280                                     then error(36);    {報36號錯,參數類型異常}
1281                              end
1282                         else begin { variable parameter }    {若是是變量形參}
1283                                if sy <> ident    {變量形參應該先識別到標識符}
1284                                then error(2)    {若不是標識符開頭,報2號錯}
1285                                else begin    {若是是標識符開頭}
1286                                       k := loc(id);    {找到當前id在表中的位置}
1287                                       insymbol;    {獲取下一個符號}
1288                                       if k <> 0        {在符號表中找到了id}
1289                                       then begin
1290                                              if tab[k].obj <> vvariable    {若是獲取到的形參類型不是變量類型}
1291                                              then error(37);    {報37號錯}
1292                                              x.typ := tab[k].typ;    {不然記錄當前的符號類型}
1293                                              x.ref := tab[k].ref;    {記錄當前參數指向的btab的位置}
1294                                              if tab[k].normal    {若是是值形參}
1295                                              then emit2(0,tab[k].lev,tab[k].adr)    {將變量地址裝入棧頂}
1296                                              else emit2(1,tab[k].lev,tab[k].adr);    {將變量的值裝入棧頂(對應變量形參)}
1297                                              if sy in [lbrack, lparent, period]    {若是後面跟的能夠是作中括號(數組下標),左括號(容錯)或句號(對應記錄)}
1298                                              then 
1299                                               selector(fsys+[comma,colon,rparent],x);    {調用分析子結構的過程來處理}
1300                                              if ( x.typ <> tab[cp].typ ) or ( x.ref <> tab[cp].ref )    {若是參數的符號類型或所在表中的位置和符號表中記錄的不一樣}
1301                                              then error(36)    {報36號錯誤}
1302                                           end
1303                                    end
1304                             end {variable parameter }
1305                       end;
1306                  test( [comma, rparent],fsys,6)    {檢查當前sym是否合法}
1307                until sy <> comma;    {直到出現的不是都好,說明參數聲明結束了}
1308                if sy = rparent    {補齊右括號}
1309                then insymbol    {獲取下一個sym}
1310                else error(4)    {沒有右括號,報4號錯誤}
1311              end;
1312         if cp < lastp    {若是當前符號的位置沒有到達最後一個符號的位置}
1313         then error(39); { too few actual parameters }    {報39號錯誤,說明符號沒有處理完}
1314         emit1(19,btab[tab[i].ref].psize-1 );    {生成19號CAL指令,正式開始過程或函數調用}
1315         if tab[i].lev < level    {若是符號所在層次小於當前層次}
1316         then emit2(3,tab[i].lev, level )    {更新display區}
1317       end { call };
1318 
1319     function resulttype( a, b : types) :types;    {處理整型或實型兩個操做數運算時的類型轉換}
1320       begin
1321         if ( a > reals ) or ( b > reals )    {若是有操做數超過上限報33號錯誤}
1322         then begin
1323                error(33);
1324                resulttype := notyp    {返回nottype}
1325              end
1326         else if ( a = notyp ) or ( b = notyp )    {兩個操做數中有一個nottype}
1327              then resulttype := notyp    {結果返回nottype}
1328              else if a = ints    {第一個是int}
1329                   then if b = ints    {第二個也是int}
1330                        then resulttype := ints    {返回int類型}
1331                        else begin
1332                               resulttype := reals;    {不然結果爲real}
1333                               emit1(26,1)    {並對a進行類型轉化}
1334                            end
1335                   else begin
1336                          resulttype := reals;    {第一個是real,則返回real}
1337                          if b = ints    {若是第二個是int}
1338                          then emit1(26,0)    {對b進行轉化}
1339                       end
1340       end { resulttype } ;
1341 
1342     procedure expression( fsys: symset; var x: item );    {處理表達式的過程,返回類型和在表中的位置}
1343       var y : item;
1344          op : symbol;
1345 
1346       procedure simpleexpression( fsys: symset; var x: item );
1347         var y : item;
1348             op : symbol;
1349 
1350         procedure term( fsys: symset; var x: item );
1351           var y : item;
1352               op : symbol;
1353 
1354           procedure factor( fsys: symset; var x: item );{處理因子的子過程}
1355             var i,f : integer;
1356 
1357             procedure standfct( n: integer );    {處理標準函數的子過程，傳入標準函數的編號n，執行不一樣的操做}
1358               var ts : typset;    {類型集合}
1359               begin  { standard function no. n }
1360                 if sy = lparent    {若是當前的符號是左括號}
1361                 then insymbol    {獲取下一個sym}
1362                 else error(9);    {若是當前符號不是左括號,報9號錯誤提示左括號出錯}
1363                 if n < 17    {若是標準函數的編號小於17}
1364                 then begin
1365                        expression( fsys+[rparent], x );    {遞歸調用處理表達式的過程來處理參數,x是獲取的參數的信息}
1366                        case n of    {根據不一樣的函數編號來進行操做}
1367                        { abs, sqr } 0,2: begin    {若是是0,2號操做,完成求絕對值和平方}
1368                                            ts := [ints, reals];    {定義符號集合爲整型和實型}
1369                                            tab[i].typ := x.typ;    {函數的返回值類型}
1370                                            if x.typ = reals    {若是參數類型是實數}
1371                                            then n := n + 1    {對應的函數標號+1}
1372                                      end;
1373                        { odd, chr } 4,5: ts := [ints];    {若是是4,5號操做,那麼完成判奇和ascii碼轉化成字符的操做,要求傳入的是髒呢掛車能}
1374                        { odr }        6: ts := [ints,bools,chars];    {6號操做容許類型是整型,布爾型或者字符型}
1375                        { succ,pred } 7,8 : begin    {對於7,8號操做}
1376                                              ts := [ints, bools,chars];    {容許參數類型是整型,布爾型或者字符型}
1377                                              tab[i].typ := x.typ    {記錄類型}
1378                                        end;
1379                        { round,trunc } 9,10,11,12,13,14,15,16:    {數學運算}
1380                        { sin,cos,... }     begin
1381                                              ts := [ints,reals];    {容許參數類型爲整型,實型}
1382                                              if x.typ = ints    {若是爲整型}
1383                                              then emit1(26,0)    {先將整型轉成實型}
1384                                        end;
1385                      end; { case }
1386                      if x.typ in ts    {若是函數的類型符合要求的符號集}
1387                      then emit1(8,n)    {調用8號指令,生成標準函數}
1388                      else if x.typ <> notyp    {若是x的類型未定義}
1389                           then error(48);    {報48號錯誤,類型錯誤}
1390                    end
1391                 else begin { n in [17,18] }    {若是編號是17或者18,即判斷輸入是否結束}
1392                        if sy <> ident    {傳入的首先應當是標識符}
1393                        then error(2)    {不是標識符報錯}
1394                        else if id <> 'input    '    {若是對應的id不是'input    '}
1395                             then error(0)    {報0號錯誤,未知id}
1396                             else insymbol;    {沒錯的話讀取下一個sym}
1397                        emit1(8,n);    {生成標準函數}
1398                      end;
1399                 x.typ := tab[i].typ;    {記錄返回值類型}
1400                 if sy = rparent    {識別是否遇到右括號}
1401                 then insymbol    {獲取下一個sym,標準函數處理過程結束}
1402                 else error(4)    {若是沒有識別到右括號,報4號錯誤}
1403               end { standfct } ;
1404             begin { factor }    {因子分析程序開始}
1405               x.typ := notyp;    {初始化返回值類型}
1406               x.ref := 0;        {初始化返回的位置指針}
1407               test( facbegsys, fsys,58 );    {檢查當前的符號是不是合法的因子開始符號}
1408               while sy in facbegsys do    {噹噹前的符號是因子的開始符號時}
1409                 begin
1410                   if sy = ident    {若是識別到標識符}
1411                   then begin
1412                          i := loc(id);    {獲取當前標識符在符號表中的位置保存到i}
1413                          insymbol;        {獲取下一個sym}
1414                          with tab[i] do    {對當前符號對應的表項進行操做}
1415                            case obj of    {對於不一樣的obj屬性執行不一樣的操做}
1416                              konstant: begin    {若是是常量類型}
1417                                          x.typ := typ;    {返回值的類型就設置爲表中記錄的typ}
1418                                          x.ref := 0;    {索引值設置爲0}
1419                                          if x.typ = reals    {若是是實數類型的常量}
1420                                          then emit1(25,adr)    {將實數裝入數據棧,注意實數常量的adr對應着其在rconst實常量表中的位置}
1421                                          else emit1(24,adr)    {若是是整型直接存入棧頂便可}
1422                                      end;
1423                              vvariable:begin    {若是換成變量類型}
1424                                              x.typ := typ;    {得到須要返回類型}
1425                                              x.ref := ref;    {得到須要返回地址}
1426                                          if sy in [lbrack, lparent,period]    {若是標識符後面跟的是左方括號,左括號或者是句號,說明該變量存在子結構}
1427                                          then begin
1428                                                 if normal    {若是是實形參}
1429                                                 then f := 0    {取地址}
1430                                                 else f := 1;    {不然是變量形參,取值並放到棧頂}
1431                                                 emit2(f,lev,adr);    {生成對應的代碼}
1432                                                 selector(fsys,x);    {處理子結構}
1433                                                 if x.typ in stantyps    {若是是標準類型}    {存疑}
1434                                                 then emit(34)    {將該值放到棧頂}
1435                                               end
1436                                          else begin    {若是變量沒有層次結構}
1437                                                 if x.typ in stantyps    {若是是標準類型}
1438                                                 then if normal    {若是是值形參}
1439                                                      then f := 1    {執行取值操做}
1440                                                      else f := 2    {不然間接取值}
1441                                                 else if normal    {若是不是標準類型可是是值形參}
1442                                                      then f := 0    {取地址操做}
1443                                                 else f := 1;    {若是既不是標準類型又不是值形參,執行取值操做}
1444                                                 emit2(f,lev,adr)    {生成對應指令}
1445                                              end
1446                                        end;
1447                              typel,prozedure: error(44);    {若是是類型類型或者過程類型,報44號類型錯誤}
1448                              funktion: begin    {若是是函數符號}
1449                                          x.typ := typ;    {記錄類型}
1450                                          if lev <> 0    {若是層次不爲0,即不是標準函數}
1451                                          then call(fsys,i)    {調用call函數來處理函數調用}
1452                                          else standfct(adr)    {若是層次爲零,調用標準函數}
1453                                        end
1454                            end { case,with }
1455                        end
1456                   else if sy in [ charcon,intcon,realcon ]    {若是符號的類型是字符類型,整數類型或者實數類型}
1457                        then begin
1458                               if sy = realcon    {對於實數類型}
1459                               then begin
1460                                      x.typ := reals;    {將返回的type設置爲實型}
1461                                      enterreal(rnum);    {將該實數放入實數表,rnum存有實數的值}
1462                                      emit1(25,c1)    {將實常量表中第c1個(也就是剛剛放進去的)元素放入棧頂}
1463                                    end
1464                               else begin
1465                                      if sy = charcon    {對於字符類型}
1466                                      then x.typ := chars    {記錄返回的類型是字符型}
1467                                      else x.typ := ints;    {不然確定是整形啦,要不進不來這個分支}
1468                                      emit1(24,inum)    {裝入字面變量,能夠看出字符型裝的是ascii碼值}
1469                                    end;
1470                               x.ref := 0;    {返回的ref設置爲0}
1471                               insymbol    {獲取下一個sym}
1472                             end
1473                    else if sy = lparent        {若是符號的類型是左括號}
1474                         then begin
1475                                insymbol;    {獲取下一個sym}
1476                                expression(fsys + [rparent],x);    {調用處理表達式的遞歸子程序處理括號中的表達式}
1477                                if sy = rparent    {若是遇到了右括號}    
1478                                then insymbol    {獲取下一個sym}
1479                                else error(4)    {沒有右括號報4號錯誤}
1480                              end
1481                    else if sy = notsy    {若是符號的類型未定義}
1482                        then begin
1483                               insymbol;    {獲取下一個sym}
1484                               factor(fsys,x);    {遞歸調用因子的分析子程序}
1485                               if x.typ = bools    {若是返回的類型是布爾型}
1486                               then emit(35)        {生成邏輯非指令}
1487                               else if x.typ <> notyp    {若是因子的類型依舊未定義}
1488                                    then error(32)    {生成32指令,退出過程}
1489                            end;
1490                   test(fsys,facbegsys,6)    {檢查當前符號是否合法}
1491                 end { while }
1492             end { factor };
1493           begin { term   }    {開始處理項(term)}
1494             factor( fsys + [times,rdiv,idiv,imod,andsy],x);    {調用因子的分析程序開分析每個因子項}
1495             while sy in [times,rdiv,idiv,imod,andsy] do    {若是因子後面跟符號'*''/''div''mod''and',說明後面還有因子,進入循環}
1496               begin
1497                 op := sy;    {運算符是sy所表明的類型}
1498                 insymbol;    {獲取下一個sym}
1499                 factor(fsys+[times,rdiv,idiv,imod,andsy],y );    {繼續調用因子分析程序來分析因子,得到第二個運算數存爲y}
1500                 if op = times    {若是遇到了乘號}
1501                 then begin
1502                        x.typ := resulttype(x.typ, y.typ);    {求出計算以後結果的類型}
1503                        case x.typ of
1504                          notyp: ;    {未定義類型不幹事兒}
1505                          ints : emit(57);    {整數生成整數乘指令}
1506                          reals: emit(60);    {實數生成實數乘指令}
1507                        end
1508                      end
1509                 else if op = rdiv    {除法運算}
1510                      then begin
1511                             if x.typ = ints
1512                             then begin
1513                                    emit1(26,1);    {整型轉實型}
1514                                    x.typ := reals;
1515                                  end;
1516                             if y.typ = ints
1517                             then begin
1518                                    emit1(26,0);    {整型轉實型}
1519                                    y.typ := reals;
1520                                  end;
1521                             if (x.typ = reals) and (y.typ = reals)
1522                             then emit(61)    {實型除法}
1523                             else begin
1524                                    if( x.typ <> notyp ) and (y.typ <> notyp)
1525                                    then error(33);
1526                                    x.typ := notyp
1527                                  end
1528                           end
1529                      else if op = andsy    {與運算}
1530                           then begin
1531                                  if( x.typ = bools )and(y.typ = bools)    {必須兩個運算數都是布爾類型}
1532                                  then emit(56)    {生成邏輯與運算}
1533                                  else begin
1534                                         if( x.typ <> notyp ) and (y.typ <> notyp)    {類型不對報錯,提示應該是布爾值}
1535                                         then error(32);
1536                                         x.typ := notyp
1537                                       end
1538                                end
1539                           else begin { op in [idiv,imod] }
1540                                  if (x.typ = ints) and (y.typ = ints)
1541                                  then if op = idiv    {若是是除法}
1542                                         then emit(58)    {生成除法運算的代碼}
1543                                       else emit(59)    {不然生成取模運算的代碼}
1544                                  else begin
1545                                         if ( x.typ <> notyp ) and (y.typ <> notyp)
1546                                         then error(34);    {類型出錯報錯}
1547                                         x.typ := notyp
1548                                       end
1549                                end
1550               end { while }
1551           end { term };
1552         begin { simpleexpression }    {開始處理簡單表達式}
1553           if sy in [plus,minus]    {得到的是加減號}
1554           then begin
1555                  op := sy;    {記錄運算符}
1556                  insymbol;
1557                  term( fsys+[plus,minus],x);    {處理項}
1558                  if x.typ > reals    {類型是 bools, chars, arrays, records}
1559                  then error(33)        {因爲不是算數運算類型,報錯}
1560                  else if op = minus    {若是是減號}
1561                       then emit(36)    {去相反數}
1562                end
1563           else term(fsys+[plus,minus,orsy],x);    
1564           while sy in [plus,minus,orsy] do
1565             begin
1566               op := sy;
1567               insymbol;
1568               term(fsys+[plus,minus,orsy],y);
1569               if op = orsy    {若是是or關鍵字}
1570               then begin
1571                      if ( x.typ = bools )and(y.typ = bools)    {操做數限定爲bool}
1572                      then emit(51)    {生成OR指令}
1573                      else begin
1574                             if( x.typ <> notyp) and (y.typ <> notyp)    {類型不對報錯}
1575                             then error(32);
1576                             x.typ := notyp
1577                           end
1578                    end
1579               else begin
1580                      x.typ := resulttype(x.typ,y.typ);    
1581                      case x.typ of
1582                        notyp: ;
1583                        ints: if op = plus    {整數加減}
1584                              then emit(52)
1585                              else emit(53);
1586                        reals:if op = plus    {實數加減}
1587                              then emit(54)
1588                              else emit(55)
1589                      end { case }
1590                    end
1591             end { while }
1592           end { simpleexpression };
1593       begin { expression  }
1594         simpleexpression(fsys+[eql,neq,lss,leq,gtr,geq],x);
1595         if sy in [ eql,neq,lss,leq,gtr,geq]    {判別多種數值比較符號}
1596         then begin
1597                op := sy;
1598                insymbol;
1599                simpleexpression(fsys,y);    {得到第二個簡單表達式的值}
1600                if(x.typ in [notyp,ints,bools,chars]) and (x.typ = y.typ)    {整型,布爾和字符均可以借用整型的運算}{notyp爲何出現?}
1601                then case op of    {根據不一樣的符號來生成不一樣的PCODE}
1602                       eql: emit(45);
1603                       neq: emit(46);
1604                       lss: emit(47);
1605                       leq: emit(48);
1606                       gtr: emit(49);
1607                       geq: emit(50);
1608                     end
1609                else begin
1610                       if x.typ = ints
1611                       then begin
1612                              x.typ := reals;
1613                              emit1(26,1)
1614                            end
1615                       else if y.typ = ints
1616                            then begin
1617                                   y.typ := reals;
1618                                   emit1(26,0)
1619                                 end;
1620                       if ( x.typ = reals)and(y.typ=reals)    {對於實數一樣生成不一樣的PCODE}
1621                       then case op of
1622                              eql: emit(39);
1623                              neq: emit(40);
1624                              lss: emit(41);
1625                              leq: emit(42);
1626                              gtr: emit(43);
1627                              geq: emit(44);
1628                            end
1629                       else error(35)
1630                     end;
1631                x.typ := bools
1632              end
1633       end { expression };
1634 
1635     procedure assignment( lv, ad: integer );    {處理賦值語句的過程}
1636       var x,y: item;
1637           f  : integer;
1638       begin   { tab[i].obj in [variable,prozedure] }    {當且僅當當前符號表的目標類型爲變量或者過程型時}
1639         x.typ := tab[i].typ;    
1640         x.ref := tab[i].ref;
1641         if tab[i].normal
1642         then f := 0
1643         else f := 1;
1644         emit2(f,lv,ad);
1645         if sy in [lbrack,lparent,period]
1646         then selector([becomes,eql]+fsys,x);    {處理下標}
1647         if sy = becomes    {賦值符號}
1648         then insymbol
1649         else begin
1650                error(51);
1651                if sy = eql    {等號容錯}
1652                then insymbol
1653              end;
1654         expression(fsys,y);    {得到賦值符號右邊的值}
1655         if x.typ = y.typ
1656         then if x.typ in stantyps
1657              then emit(38)    {完成賦值操做}
1658              else if x.ref <> y.ref
1659                   then error(46)
1660              else if x.typ = arrays    {數組類型須要拷貝塊}
1661                   then emit1(23,atab[x.ref].size)    {拷貝atab中的項}
1662                   else emit1(23,btab[x.ref].vsize)    {拷貝btab中的記錄項}
1663         else if(x.typ = reals )and (y.typ = ints)
1664         then begin
1665                emit1(26,0);
1666                emit(38)
1667              end
1668         else if ( x.typ <> notyp ) and ( y.typ <> notyp )
1669              then error(46)
1670       end { assignment };
1671 
1672     procedure compoundstatement;
1673       begin
1674         insymbol;
1675         statement([semicolon,endsy]+fsys);
1676         while sy in [semicolon]+statbegsys do
1677           begin
1678             if sy = semicolon
1679             then insymbol
1680             else error(14);
1681             statement([semicolon,endsy]+fsys)
1682           end;
1683         if sy = endsy
1684         then insymbol
1685         else error(57)
1686       end { compoundstatement };
1687 
1688     procedure ifstatement;
1689       var x : item;
1690           lc1,lc2: integer;
1691       begin
1692         insymbol;
1693         expression( fsys+[thensy,dosy],x);
1694         if not ( x.typ in [bools,notyp])
1695         then error(17);
1696         lc1 := lc;
1697         emit(11);  { jmpc }
1698         if sy = thensy
1699         then insymbol
1700         else begin
1701                error(52);
1702                if sy = dosy
1703                then insymbol
1704              end;
1705         statement( fsys+[elsesy]);
1706         if sy = elsesy
1707         then begin
1708                insymbol;
1709                lc2 := lc;
1710                emit(10);
1711                code[lc1].y := lc;
1712                statement(fsys);
1713                code[lc2].y := lc
1714              end
1715         else code[lc1].y := lc
1716       end { ifstatement };
1717 
1718     procedure casestatement;{case語句的處理過程}
1719       var x : item;
1720       i,j,k,lc1 : integer;    {定義一系列臨時變量}
1721       casetab : array[1..csmax]of    {csmax表示case個數的最大限度}
1722                      packed record
1723                        val,lc : index    {index表示}
1724                      end;
1725           exittab : array[1..csmax] of integer;
1726 
1727       procedure caselabel;    {處理case語句中的標號,將各標號對應的目標代碼入口地址填入casetab表中,並檢查標號有無重複定義}
1728         var lab : conrec;
1729          k : integer;
1730         begin
1731           constant( fsys+[comma,colon],lab );    {由於標籤都是常量,這裏調用處理常量的過程來得到常量的值,存於lab}
1732           if lab.tp <> x.typ    {若是得到的標籤類型和變量的類型不一樣}
1733           then error(47)    {報label類型錯誤}
1734           else if i = csmax    {若是能夠聲明的case達到了最大限度}
1735                then fatal(6)    {報6號嚴重錯誤,程序終止}
1736                else begin
1737                       i := i+1;    {移動case表的指針,聲明新的case}
1738                        k := 0;    {用來檢查標號是否重複定義的變量}
1739                       casetab[i].val := lab.i;    {保存新case的值}
1740                       casetab[i].lc := lc;        {記錄新case生成代碼的位置}
1741                       repeat
1742                         k := k+1
1743                       until casetab[k].val = lab.i;    {掃一遍已經聲明的label,看有沒有重複聲明}
1744                       if k < i    {重複聲明}
1745                       then error(1); { multiple definition }    {報1號錯誤}
1746                     end
1747         end { caselabel };
1748 
1749       procedure onecase;    {用來處理case語句的一個分支}
1750         begin
1751           if sy in constbegsys    {肯定當前符號是常量的類型集合}
1752           then begin
1753                  caselabel;    {獲取一個標籤}
1754                  while sy = comma do    {若是有逗號說明是一個case對應多個標籤的狀況}
1755                    begin
1756                      insymbol;    {繼續獲取標籤的label}
1757                      caselabel    {繼續處理}
1758                    end;
1759                  if sy = colon    {讀到冒號,說明label聲明結束了}
1760                  then insymbol    {獲取下一個sym}
1761                  else error(5);    {沒讀到冒號,報5號錯誤}
1762                  statement([semicolon,endsy]+fsys);    {遞歸調用statement來處理冒號以後須要執行的程序}
1763                  j := j+1;    {用來記錄當前case對應exittab的位置}
1764                  exittab[j] := lc;    {記錄當前case分支結束的代碼位置,即下面將要生成的跳轉指令的位置}
1765                  emit(10)    {生成一條跳轉指令來結束這一case分支}
1766                end
1767           end { onecase };
1768       begin  { casestatement  }
1769         insymbol;    {獲取下一個sym}
1770         i := 0;
1771         j := 0;
1772         expression( fsys + [ofsy,comma,colon],x );    {遞歸調用處理表達式的方式先得到當前表達式的屬性,即case後面變量的類型}
1773         if not( x.typ in [ints,bools,chars,notyp ])    {若是當前的表達式不是整數,布爾型,字符型或未定義類型}
1774         then error(23);    {報23號錯誤,case類型錯誤}
1775         lc1 := lc;    {記錄當前PCODE代碼的位置指針}
1776         emit(12); {jmpx}    {生成SWT代碼,查找狀況表,注意這裏暫時沒有給定跳轉的地址}
1777         if sy = ofsy    {若是接着讀到了of關鍵字}
1778         then insymbol    {獲取下一個sym}
1779         else error(8);    {丟失of關鍵字的狀況報8號錯}
1780         onecase;    {調用onecase方法處理}
1781         while sy = semicolon do    {遇到了分號,說明還有更多的case分支}
1782           begin
1783             insymbol;    {獲取下一個sym}
1784             onecase        {處理下一個sym}
1785           end;
1786         code[lc1].y := lc;    {此時肯定了狀況表的開始地址,回填給以前聲明的SWT代碼,確保其可以成功跳轉}
1787         for k := 1 to i do    {便利全部case分支}
1788           begin    {創建狀況表}
1789             emit1( 13,casetab[k].val);    {創建查找的值}
1790             emit1( 13,casetab[k].lc);    {給出對應的跳轉地址}
1791           end;
1792         emit1(10,0);    {生成JMP代碼,說明狀況表結束}
1793         for k := 1 to j do    {給定每一個case分支退出以後的跳轉地址}
1794           code[exittab[k]].y := lc;    {如今的lc指向狀況表結束以後的位置,將各分支的結束跳轉地址指向這裏}
1795         if sy = endsy    {若是遇到了end關鍵字}
1796         then insymbol    {讀取下一個sym,case處理完畢}
1797         else error(57)    {不然報57號錯誤}
1798       end { casestatement };
1799 
1800     procedure repeatstatement;{處理repeat語句的處理過程}
1801       var x : item;        {用來獲取返回值}
1802           lc1: integer;    {用來記錄repeat的開始位置}
1803       begin
1804         lc1 := lc;    {保存repeat當開始時的代碼地址}
1805         insymbol;    {獲取下一個sym}
1806         statement( [semicolon,untilsy]+fsys);    {調用statement遞歸子程序來處理循環體中的語句}
1807         while sy in [semicolon]+statbegsys do    {若是遇到了分號或者statement的開始符號,則說明循環體中還有語句沒有處理完}
1808           begin
1809             if sy = semicolon    {若是確實是分號}
1810             then insymbol    {獲取下一個sym}
1811             else error(14);    {報14號錯,提示分號錯誤}
1812             statement([semicolon,untilsy]+fsys)    {處理循環體中的下一條語句}
1813           end;
1814         if sy = untilsy    {若是遇到了until關鍵字}
1815         then begin
1816                insymbol;    {獲取下一個sym,即循環條件}
1817                expression(fsys,x);    {處理該表達式,得到其類型}
1818                if not(x.typ in [bools,notyp] )    {若是不是未定義類型或者布爾型的表達式}
1819                then error(17);    {報17號錯誤,提示須要布爾型表達式}
1820                emit1(11,lc1);    {生成一條條件跳轉指令,若是表達式的值是假的,則跳轉回repeat開始的位置從新執行一遍}
1821              end
1822         else error(53)    {沒找到until,報53號錯}
1823       end { repeatstatement };
1824 
1825     procedure whilestatement;    {處理while循環的過程}
1826       var x : item;        
1827           lc1,lc2 : integer;
1828       begin
1829         insymbol;
1830         lc1 := lc;
1831         expression( fsys+[dosy],x);
1832         if not( x.typ in [bools, notyp] )
1833         then error(17);
1834         lc2 := lc;
1835         emit(11);
1836         if sy = dosy
1837         then insymbol
1838         else error(54);
1839         statement(fsys);
1840         emit1(10,lc1);
1841         code[lc2].y := lc
1842      end { whilestatement };
1843 
1844     procedure forstatement;    {處理for循環語句}
1845       var   cvt : types;
1846             x :  item;
1847             i,f,lc1,lc2 : integer;
1848      begin
1849         insymbol;    {獲取下一個sym}
1850         if sy = ident    {若是獲取到的是標識符}
1851         then begin
1852                i := loc(id);    {找到這個標識符在符號表中登錄的位置,其實是計數變量}
1853                insymbol;    {獲取下一個sym}
1854                if i = 0    {若是沒有找到這個標識符}
1855                then cvt := ints    {計數變量類型默認爲整形}
1856                else if tab[i].obj = vvariable    {若是對應的這個標識符對應符號的大類是變量類型}
1857                     then begin
1858                            cvt := tab[i].typ;    {計數變量類型就設置爲這個變量的類型}
1859                            if not tab[i].normal    {若是是變量形參,即變量存儲的是值而非地址}
1860                            then error(37)        {報37號錯}
1861                            else emit2(0,tab[i].lev, tab[i].adr );    {若是不是變量類型, 獲取該符號的地址}
1862                            if not ( cvt in [notyp, ints, bools, chars])    {若是獲取到計數變量的類型不是未定義,整型,布爾型,字符型}
1863                                    then error(18)    {報18號錯誤}
1864                          end
1865                     else begin    {若是符號的類型也不是變量}
1866                            error(37);    {報37號錯誤}
1867                            cvt := ints    {將計數變量類型設置爲整型}    {僅僅是給個值,仍是有什麼意義?}
1868                          end
1869              end
1870         else skip([becomes,tosy,downtosy,dosy]+fsys,2);    {跳過無用符號}
1871         if sy = becomes    {若是識別到了賦值符號}
1872         then begin
1873                insymbol;    {獲取下一個sym}
1874                expression( [tosy, downtosy,dosy]+fsys,x);    {遞歸調用處理表達式的方式來得到表達式的值和類型}
1875                if x.typ <> cvt    {若是獲取到的表達式類型和計數變量的符號類型不相同}
1876                then error(19);    {報19號錯誤}
1877              end
1878         else skip([tosy, downtosy,dosy]+fsys,51);    {未識別到賦值符號,則繼續執行}
1879         f := 14;    {生成指令的編號,暫存14號}
1880         if sy in [tosy,downtosy]    {若是當前符號是to關鍵字或者downto關鍵字,其中to是每次循環變量自加一,downto是每次循環變量自減一}
1881         then begin
1882                if sy = downtosy    {若是是down}
1883                then f := 16;    {}
1884                insymbol;        {獲取下一個sym}
1885                expression([dosy]+fsys,x);    {調用處理表達式的遞歸子程序處理括號中的表達式}
1886                if x.typ <> cvt    {若是表達式的類型和左邊的計數變量不一樣}
1887                then error(19)    {報19號錯誤}
1888              end
1889         else skip([dosy]+fsys,55);    {跳過直到do以前的代碼段}
1890         lc1 := lc;    {記錄下句F1U指令的位置}
1891         emit(f);    {生成F1U或F1D指令,進行循環體的入口測試}
1892         if sy = dosy    {若是當前符號是do關鍵字}
1893         then insymbol    {獲取下一個sym}
1894         else error(54);    {沒找到do,報54號錯誤}
1895         lc2 := lc;    {獲取循環體開始代碼的位置}
1896         statement(fsys);    {遞歸調用statement來處理循環體語句}
1897         emit1(f+1,lc2);        {結束時生成F2U或F2D指令}
1898         code[lc1].y := lc    {將以前產生的F1U的跳轉地址回傳回去}
1899      end { forstatement };
1900 
1901     procedure standproc( n: integer );
1902       var i,f : integer;
1903       x,y : item;
1904       begin
1905         case n of
1906           1,2 : begin { read }
1907                   if not iflag
1908                   then begin
1909                          error(20);
1910                          iflag := true
1911                        end;
1912                   if sy = lparent
1913                   then begin
1914                          repeat
1915                            insymbol;
1916                            if sy <> ident
1917                            then error(2)
1918                            else begin
1919                                   i := loc(id);
1920                                   insymbol;
1921                                   if i <> 0
1922                                   then if tab[i].obj <> vvariable
1923                                        then error(37)
1924                                        else begin
1925                                               x.typ := tab[i].typ;
1926                                               x.ref := tab[i].ref;
1927                                               if tab[i].normal
1928                                               then f := 0
1929                                               else f := 1;
1930                                               emit2(f,tab[i].lev,tab[i].adr);
1931                                               if sy in [lbrack,lparent,period]
1932                                               then selector( fsys+[comma,rparent],x);
1933                                               if x.typ in [ints,reals,chars,notyp]
1934                                               then emit1(27,ord(x.typ))
1935                                               else error(41)
1936                                            end
1937                                end;
1938                            test([comma,rparent],fsys,6);
1939                          until sy <> comma;
1940                          if sy = rparent
1941                          then insymbol
1942                          else error(4)
1943                        end;
1944                   if n = 2
1945                   then emit(62)
1946                 end;
1947           3,4 : begin { write }
1948                   if sy = lparent
1949                   then begin
1950                          repeat
1951                            insymbol;
1952                            if sy = stringcon
1953                            then begin
1954                                   emit1(24,sleng);
1955                                   emit1(28,inum);
1956                                   insymbol
1957                                 end
1958                            else begin
1959                                   expression(fsys+[comma,colon,rparent],x);
1960                                   if not( x.typ in stantyps )
1961                                   then error(41);
1962                                   if sy = colon
1963                                   then begin
1964                                          insymbol;
1965                                          expression( fsys+[comma,colon,rparent],y);
1966                                          if y.typ <> ints
1967                                          then error(43);
1968                                          if sy = colon
1969                                          then begin
1970                                                 if x.typ <> reals
1971                                                 then error(42);
1972                                                 insymbol;
1973                                                 expression(fsys+[comma,rparent],y);
1974                                                 if y.typ <> ints
1975                                                 then error(43);
1976                                                 emit(37)
1977                                               end
1978                                          else emit1(30,ord(x.typ))
1979                                        end
1980                              else emit1(29,ord(x.typ))
1981                            end
1982                          until sy <> comma;
1983                          if sy = rparent
1984                          then insymbol
1985                          else error(4)
1986                        end;
1987                   if n = 4
1988                   then emit(63)
1989                 end; { write }
1990         end { case };
1991       end { standproc } ;
1992     begin { statement }
1993       if sy in statbegsys+[ident]
1994       then case sy of
1995              ident : begin
1996                        i := loc(id);
1997                        insymbol;
1998                        if i <> 0
1999                        then case tab[i].obj of
2000                               konstant,typel : error(45);
2001                               vvariable:       assignment( tab[i].lev,tab[i].adr);
2002                               prozedure:       if tab[i].lev <> 0
2003                                                then call(fsys,i)
2004                                                else standproc(tab[i].adr);
2005                               funktion:        if tab[i].ref = display[level]
2006                                                then assignment(tab[i].lev+1,0)
2007                                                else error(45)
2008                             end { case }
2009                      end;
2010              beginsy : compoundstatement;
2011              ifsy    : ifstatement;
2012              casesy  : casestatement;
2013              whilesy : whilestatement;
2014              repeatsy: repeatstatement;
2015              forsy   : forstatement;
2016            end;  { case }
2017       test( fsys, [],14);
2018     end { statement };
2019   begin  { block }
2020     dx := 5;    {dx是變量存儲分配的索引,預設爲5是爲了給內務信息區留出空間}
2021     prt := t;    {獲取當前符號表的位置}
2022     if level > lmax    {若是當前子程序的層次已經超過了容許的最大層次}
2023     then fatal(5);    {報5號錯誤}
2024     test([lparent,colon,semicolon],fsys,14);    {檢查當前的符號是不是左括號,冒號,分號中的一個,不是報14號錯誤}
2025     enterblock;
2026     prb := b;
2027     display[level] := b;
2028     tab[prt].typ := notyp;
2029     tab[prt].ref := prb;
2030     if ( sy = lparent ) and ( level > 1 )
2031     then parameterlist;
2032     btab[prb].lastpar := t;
2033     btab[prb].psize := dx;
2034     if isfun
2035     then if sy = colon
2036          then begin
2037                 insymbol; { function type }
2038                 if sy = ident
2039                 then begin
2040                        x := loc(id);
2041                        insymbol;
2042                        if x <> 0
2043                        then if tab[x].typ in stantyps
2044                             then tab[prt].typ := tab[x].typ
2045                             else error(15)
2046                      end
2047                 else skip( [semicolon]+fsys,2 )
2048               end
2049          else error(5);
2050     if sy = semicolon
2051     then insymbol
2052     else error(14);
2053     repeat
2054       if sy = constsy
2055       then constdec;
2056       if sy = typesy
2057       then typedeclaration;
2058       if sy = varsy
2059       then variabledeclaration;
2060       btab[prb].vsize := dx;
2061       while sy in [procsy,funcsy] do
2062         procdeclaration;
2063       test([beginsy],blockbegsys+statbegsys,56)
2064     until sy in statbegsys;
2065     tab[prt].adr := lc;
2066     insymbol;
2067     statement([semicolon,endsy]+fsys);
2068     while sy in [semicolon]+statbegsys do
2069       begin
2070         if sy = semicolon
2071         then insymbol
2072         else error(14);
2073         statement([semicolon,endsy]+fsys);
2074       end;
2075     if sy = endsy
2076     then insymbol
2077     else error(57);
2078     test( fsys+[period],[],6 )
2079   end { block };
2080 
2081 
2082 
2083 procedure interpret;
2084   var ir : order ;         { instruction buffer }    {當前的指令}
2085       pc : integer;        { program counter }    {相似於指令寄存器}
2086       t  : integer;        { top stack index }    {棧頂指針}
2087       b  : integer;        { base index }    {基址地址}
2088       h1,h2,h3: integer;    {臨時變量}
2089       lncnt,ocnt,blkcnt,chrcnt: integer;     { counters }
2090       ps : ( run,fin,caschk,divchk,inxchk,stkchk,linchk,lngchk,redchk );    {各類錯誤信息標誌}
2091            fld: array [1..4] of integer;  { default field widths }
2092            display : array[0..lmax] of integer;
2093            s  : array[1..stacksize] of   { blockmark:     }
2094             record
2095               case cn : types of        { s[b+0] = fct result }
2096                 ints : (i: integer );   { s[b+1] = return adr }
2097                 reals :(r: real );      { s[b+2] = static link }
2098                 bools :(b: boolean );   { s[b+3] = dynamic link }
2099                 chars :(c: char )       { s[b+4] = table index }
2100             end;
2101 
2102   procedure dump;
2103     var p,h3 : integer;
2104     begin
2105       h3 := tab[h2].lev;
2106       writeln(psout);
2107       writeln(psout);
2108       writeln(psout,'       calling ', tab[h2].name );
2109       writeln(psout,'         level ',h3:4);
2110       writeln(psout,' start of code ',pc:4);
2111       writeln(psout);
2112       writeln(psout);
2113       writeln(psout,' contents of display ');
2114       writeln(psout);
2115       for p := h3 downto 0 do
2116         writeln(psout,p:4,display[p]:6);
2117       writeln(psout);
2118       writeln(psout);
2119       writeln(psout,' top of stack  ',t:4,' frame base ':14,b:4);
2120       writeln(psout);
2121       writeln(psout);
2122       writeln(psout,' stack contents ':20);
2123       writeln(psout);
2124       for p := t downto 1 do
2125         writeln( psout, p:14, s[p].i:8);
2126       writeln(psout,'< = = = >':22)
2127     end; {dump }
2128     {如下爲不一樣PCODE所對應的操做}
2129   procedure inter0;
2130     begin
2131       case ir.f of
2132         0 : begin { load addrss }    {取地址操做,LDA}
2133               t := t + 1;    {棧頂指針上移}
2134               if t > stacksize    {若是超過了棧的大小上限}
2135               then ps := stkchk    {將ps設置爲stkchk,以記錄錯誤類型}
2136               else s[t].i := display[ir.x]+ir.y    {完成取值, 實際地址 = level起始地址+位移地址,放到棧頂}
2137             end;
2138         1 : begin  { load value }    {取值操做,LOD}
2139               t := t + 1;    
2140               if t > stacksize    {檢查棧是否溢出,溢出則報錯}
2141               then ps := stkchk
2142               else s[t] := s[display[ir.x]+ir.y]    {因爲傳入的是地址,完成取值後將值放到棧頂}
2143             end;
2144         2 : begin  { load indirect }    {間接取值,LDI}
2145               t := t + 1;
2146               if t > stacksize
2147               then ps := stkchk
2148               else s[t] := s[s[display[ir.x]+ir.y].i]
2149             end;
2150         3 : begin  { update display }    {更新display,DIS}
2151               h1 := ir.y;
2152               h2 := ir.x;
2153               h3 := b;
2154               repeat
2155                 display[h1] := h3;    
2156                 h1 := h1-1;    {level-1}
2157                 h3 := s[h3+2].i
2158               until h1 = h2
2159             end;
2160         8 : case ir.y of    {標準函數,ir.y是函數的編號,FCT}
2161               0 : s[t].i := abs(s[t].i);    {整數x求絕對值}
2162               1 : s[t].r := abs(s[t].r);    {實數x求絕對值}
2163               2 : s[t].i := sqr(s[t].i);    {整數x求平方}
2164               3 : s[t].r := sqr(s[t].r);    {實數x求平方}
2165               4 : s[t].b := odd(s[t].i);    {整數x判奇偶性,計數返回1}
2166               5 : s[t].c := chr(s[t].i);    {ascii碼x轉化爲字符char}
2167               6 : s[t].i := ord(s[t].c);    {字符x轉化爲ascii碼}
2168               7 : s[t].c := succ(s[t].c);    {求字符x的後繼字符,好比'a'的後繼是'b'}
2169               8 : s[t].c := pred(s[t].c);    {求字符x的前導字符}
2170               9 : s[t].i := round(s[t].r);    {求x的四捨五入}
2171               10 : s[t].i := trunc(s[t].r);    {求實數x的整數部分}
2172               11 : s[t].r := sin(s[t].r);    {求正弦sin(x),注意x爲實數弧度}
2173               12 : s[t].r := cos(s[t].r);    {求餘弦sin(x),注意x爲實數弧度}
2174               13 : s[t].r := exp(s[t].r);    {求e^x,x爲實數}
2175               14 : s[t].r := ln(s[t].r);    {求天然對數ln(x),x爲實數}
2176               15 : s[t].r := sqrt(s[t].r);    {實數x開方}
2177               16 : s[t].r := arcTan(s[t].r);    {反三角函數arctan(x)}
2178               17 : begin
2179                      t := t+1;    {}
2180                      if t > stacksize
2181                      then ps := stkchk
2182                      else s[t].b := eof(prd)    {判斷輸入有沒有讀完}
2183                    end;
2184               18 : begin
2185                      t := t+1;
2186                      if t > stacksize
2187                      then ps := stkchk
2188                      else s[t].b := eoln(prd)    {判斷該行有沒有讀完}
2189                    end;
2190             end;
2191         9 : s[t].i := s[t].i + ir.y; { offset }    {將棧頂元素加上y,INT}
2192       end { case ir.y }
2193     end; { inter0 }
2194 
2195 procedure inter1;
2196     var h3, h4: integer;
2197 begin
2198       case ir.f of
2199         10 : pc := ir.y ; { jump }    {調到第y條指令代碼,JMP}
2200         11 : begin  { conditional jump }    {條件跳轉語句,JPC}
2201                if not s[t].b    {若是棧頂值爲假}
2202                then pc := ir.y;    {跳轉到y指令}
2203                t := t - 1    {退棧}
2204             end;
2205         12 : begin { switch }    {轉移到y的地址,查找狀況表,狀況表由一系列f爲13的指令構成}
2206                h1 := s[t].i;    {記錄棧頂值}
2207                t := t-1;    {退棧}
2208                h2 := ir.y;    {記錄須要跳轉到的地址}
2209                h3 := 0;
2210                repeat
2211                  if code[h2].f <> 13    {若是操做碼不是13,證實跳轉到的不是狀況表}
2212                  then begin
2213                         h3 := 1;
2214                         ps := caschk
2215                       end
2216                  else if code[h2].y = h1
2217                       then begin
2218                              h3 := 1;
2219                              pc := code[h2+1].y
2220                            end
2221                       else h2 := h2 + 2
2222                until h3 <> 0
2223              end;
2224         14 : begin { for1up }    {增量步長for循環的初始判斷,F1U}
2225                h1 := s[t-1].i;    {for循環以前須要儲存計數變量的地址,初值和終值,這裏h1獲取的是初值}
2226                if h1 <= s[t].i    {若是初值小於等於終值}
2227                then s[s[t-2].i].i := h1    {開始循環,將技術變量的值賦爲初值}
2228                else begin    {不然循環完畢}
2229                       t := t - 3;    {退棧3格,退去計數變量的地址,初值和終值所佔用的空間}
2230                       pc := ir.y    {跳出循環,注意這裏的y是由後方語句回傳獲得的}
2231                     end
2232              end;
2233         15 : begin { for2up }    {增量步長的結束判斷,F2U}
2234                h2 := s[t-2].i;    {得到計數變量的地址}
2235                h1 := s[h2].i+1;    {h1爲計數變量的值自增一}
2236                if h1 <= s[t].i    {判斷是否還知足循環條件}
2237                then begin
2238                       s[h2].i := h1;    {若是知足,將h1賦給計數變量}
2239                       pc := ir.y    {跳轉到循環的開始位置}
2240                     end
2241                else t := t-3;    {不知足的狀況不作跳轉(執行下一條),退棧3格}
2242              end;
2243         16 : begin  { for1down }    {減量步長for循環的初始判斷,F1U}
2244                h1 := s[t-1].i;
2245                if h1 >= s[t].i
2246                then s[s[t-2].i].i := h1
2247                else begin
2248                       pc := ir.y;
2249                       t := t - 3
2250                     end
2251              end;
2252         17 : begin  { for2down }    {減量步長的結束判斷,F2U}
2253                h2 := s[t-2].i;
2254                h1 := s[h2].i-1;
2255                if h1 >= s[t].i
2256                then begin
2257                       s[h2].i := h1;
2258                       pc := ir.y
2259                     end
2260                else t := t-3;
2261              end;
2262         18 : begin  { mark stack }    {標記棧}
2263                h1 := btab[tab[ir.y].ref].vsize;    {得到當前過程所須要的棧空間的大小}
2264                if t+h1 > stacksize    {若是超過上限報錯}
2265                then ps := stkchk
2266                else begin
2267                       t := t+5;    {預留內務信息區}
2268                       s[t-1].i := h1-1;    {次棧頂存放vsize-1}
2269                       s[t].i := ir.y    {棧頂存放被調用過程在tab表中的位置}
2270                     end
2271              end;
2272         19 : begin  { call }    {過程或函數調用過程}
2273                h1 := t-ir.y;  { h1 points to base }    {h1指向基址}
2274                h2 := s[h1+4].i;  { h2 points to tab }    {h2指向過程名在tab表中的位置}
2275                h3 := tab[h2].lev;    {h3記錄當前過程或函數的層次}
2276                display[h3+1] := h1;    {新建一個層次,並將該層次基址指向當前層次基址}
2277                h4 := s[h1+3].i+h1;    {DL的值}
2278                s[h1+1].i := pc;    
2279                s[h1+2].i := display[h3];
2280                s[h1+3].i := b;
2281                for h3 := t+1 to h4 do
2282                  s[h3].i := 0;
2283                b := h1;
2284                t := h4;
2285                pc := tab[h2].adr;
2286                if stackdump
2287                then dump
2288              end;
2289       end { case }
2290     end; { inter1 }
2291 
2292   procedure inter2;
2293     begin
2294       case ir.f of
2295         20 : begin   { index1 }
2296                h1 := ir.y;  { h1 points to atab }
2297                h2 := atab[h1].low;
2298                h3 := s[t].i;
2299                if h3 < h2
2300                then ps := inxchk
2301                else if h3 > atab[h1].high
2302                     then ps := inxchk
2303                     else begin
2304                            t := t-1;
2305                            s[t].i := s[t].i+(h3-h2)
2306                          end
2307              end;
2308         21 : begin  { index }
2309                h1 := ir.y ; { h1 points to atab }
2310                h2 := atab[h1].low;
2311                h3 := s[t].i;
2312                if h3 < h2
2313                then ps := inxchk
2314                else if h3 > atab[h1].high
2315                     then ps := inxchk
2316                     else begin
2317                            t := t-1;
2318                            s[t].i := s[t].i + (h3-h2)*atab[h1].elsize
2319                          end
2320              end;
2321         22 : begin  { load block }    {裝入塊,LDB}
2322                h1 := s[t].i;    {獲取棧頂值}
2323                t := t-1;
2324                h2 := ir.y+t;    {獲取須要分配到的空間位置}
2325                if h2 > stacksize    {棧空間不足,報錯}
2326                then ps := stkchk
2327                else while t < h2 do    {將h1指向的塊的值裝入棧頂}
2328                       begin
2329                         t := t+1;
2330                         s[t] := s[h1];
2331                         h1 := h1+1
2332                       end
2333              end;
2334         23 : begin  { copy block }
2335                h1 := s[t-1].i;
2336                h2 := s[t].i;
2337                h3 := h1+ir.y;
2338                while h1 < h3 do
2339                  begin
2340                    s[h1] := s[h2];
2341                    h1 := h1+1;
2342                    h2 := h2+1
2343                  end;
2344                t := t-2
2345              end;
2346         24 : begin  { literal }        {裝入字面變量,LDC}
2347                t := t+1;
2348                if t > stacksize
2349                then ps := stkchk
2350                else s[t].i := ir.y    {對於整型變量y直接裝入棧頂}
2351              end;
2352         25 : begin  { load real }    {讀取實數,LDR}
2353                t := t+1;
2354                if t > stacksize
2355                then ps := stkchk
2356                else s[t].r := rconst[ir.y]    {將實常量表中第i個元素放到數據棧的棧頂}
2357              end;
2358         26 : begin  { float }    {整型轉實型,FLT}
2359                h1 := t-ir.y;    {得到符號的地址}
2360                s[h1].r := s[h1].i    {令實型等於整數部分}
2361              end;
2362         27 : begin  { read }
2363                if eof(prd)
2364                then ps := redchk
2365                else case ir.y of
2366                       1 : read(prd, s[s[t].i].i);
2367                       2 : read(prd, s[s[t].i].r);
2368                       4 : read(prd, s[s[t].i].c);
2369                     end;
2370                t := t-1
2371              end;
2372         28 : begin   { write string }
2373                h1 := s[t].i;
2374                h2 := ir.y;
2375                t := t-1;
2376                chrcnt := chrcnt+h1;
2377                if chrcnt > lineleng
2378                then ps := lngchk;
2379                repeat
2380                  write(prr,stab[h2]);
2381                  h1 := h1-1;
2382                  h2 := h2+1
2383                until h1 = 0
2384              end;
2385         29 : begin  { write1 }
2386                chrcnt := chrcnt + fld[ir.y];
2387                if chrcnt > lineleng
2388                then ps := lngchk
2389                else case ir.y of
2390                       1 : write(prr,s[t].i:fld[1]);
2391                       2 : write(prr,s[t].r:fld[2]);
2392                       3 : if s[t].b
2393                           then write('true')
2394                           else write('false');
2395                       4 : write(prr,chr(s[t].i));
2396                     end;
2397                t := t-1
2398              end;
2399       end { case }
2400     end; { inter2 }
2401 
2402   procedure inter3;
2403     begin
2404       case ir.f of
2405         30 : begin { write2 }
2406                chrcnt := chrcnt+s[t].i;
2407                if chrcnt > lineleng
2408                then ps := lngchk
2409                else case ir.y of
2410                       1 : write(prr,s[t-1].i:s[t].i);
2411                       2 : write(prr,s[t-1].r:s[t].i);
2412                       3 : if s[t-1].b
2413                           then write('true')
2414                           else write('false');
2415                     end;
2416                t := t-2
2417              end;
2418         31 : ps := fin;
2419         32 : begin  { exit procedure }    {退出過程,EXP}
2420                t := b-1;    {退棧}
2421                pc := s[b+1].i;    {PC指向RA}
2422                b := s[b+3].i    {得到返回後的base基址,s[b+3]指向DL}
2423              end;
2424         33 : begin  { exit function }    {退出函數,EXF}
2425                t := b;    {退棧,注意要保留函數名}
2426                pc := s[b+1].i;    {PC指向RA}
2427                b := s[b+3].i    {得到返回後的base基址,s[b+3]指向DL}
2428              end;
2429         34 : s[t] := s[s[t].i];
2430         35 : s[t].b := not s[t].b;    {邏輯非運算,將棧頂布爾值取反,NOT}
2431         36 : s[t].i := -s[t].i;        {取整數的相反數操做,MUS}
2432         37 : begin
2433                chrcnt := chrcnt + s[t-1].i;
2434                if chrcnt > lineleng
2435                then ps := lngchk
2436                else write(prr,s[t-2].r:s[t-1].i:s[t].i);
2437                t := t-3
2438              end;
2439         38 : begin  { store }    {將棧頂內容存入以次棧頂爲地址的單元,STO}
2440                s[s[t-1].i] := s[t];
2441                t := t-2
2442              end;
2443         39 : begin    {實數相等,EQR}
2444                t := t-1;
2445                s[t].b := s[t].r=s[t+1].r
2446              end;
2447       end { case }
2448     end; { inter3 }
2449 
2450   procedure inter4;
2451     begin
2452       case ir.f of
2453         40 : begin    {實數不等,NER}
2454                t := t-1;
2455                s[t].b := s[t].r <> s[t+1].r
2456              end;
2457         41 : begin    {實數小於,LSR}
2458                t := t-1;
2459                s[t].b := s[t].r < s[t+1].r
2460              end;
2461         42 : begin    {實數小於等於,LER}
2462                t := t-1;
2463                s[t].b := s[t].r <= s[t+1].r
2464              end;
2465         43 : begin    {實數大於,GTR}
2466                t := t-1;
2467                s[t].b := s[t].r > s[t+1].r
2468              end;
2469         44 : begin    {實數大於等於,GER}
2470                t := t-1;
2471                s[t].b := s[t].r >= s[t+1].r
2472              end;
2473         45 : begin    {整數相等,EQL}
2474                t := t-1;
2475                s[t].b := s[t].i = s[t+1].i
2476              end;
2477         46 : begin    {整型不等,NEQ}
2478                t := t-1;
2479                s[t].b := s[t].i <> s[t+1].i
2480              end;
2481         47 : begin    {整型小於,LSS}
2482                t := t-1;
2483                s[t].b := s[t].i < s[t+1].i
2484              end;
2485         48 : begin    {整型小於等於,LEQ}
2486                t := t-1;
2487                s[t].b := s[t].i <= s[t+1].i
2488              end;
2489         49 : begin    {整型大於,GRT}
2490                t := t-1;
2491                s[t].b := s[t].i > s[t+1].i
2492              end;
2493       end { case }
2494     end; { inter4 }
2495 
2496   procedure inter5;
2497     begin
2498       case ir.f of
2499         50 : begin    {整型大於等於,GEQ}
2500                t := t-1;
2501                s[t].b := s[t].i >= s[t+1].i
2502              end;
2503         51 : begin    {OR指令,ORR}
2504                t := t-1;
2505                s[t].b := s[t].b or s[t+1].b
2506              end;
2507         52 : begin    {整數加,ADD}
2508                t := t-1;
2509                s[t].i := s[t].i+s[t+1].i
2510              end;
2511         53 : begin    {整數減,SUB}
2512                t := t-1;
2513                s[t].i := s[t].i-s[t+1].i
2514              end;
2515         54 : begin    {實數加,ADR}
2516                t := t-1;
2517                s[t].r := s[t].r+s[t+1].r;
2518              end;    
2519         55 : begin    {實數減,SUR}
2520                t := t-1;
2521                s[t].r := s[t].r-s[t+1].r;
2522              end;
2523         56 : begin    {與運算,AND}
2524                t := t-1;
2525                s[t].b := s[t].b and s[t+1].b
2526              end;
2527         57 : begin    {整數乘,MUL}
2528                t := t-1;
2529                s[t].i := s[t].i*s[t+1].i
2530              end;
2531         58 : begin    {整數除法,DIV}
2532                t := t-1;
2533                if s[t+1].i = 0
2534                then ps := divchk
2535                else s[t].i := s[t].i div s[t+1].i
2536              end;
2537         59 : begin    {取模運算,MOD}
2538                t := t-1;
2539                if s[t+1].i = 0
2540                then ps := divchk
2541                else s[t].i := s[t].i mod s[t+1].i
2542              end;
2543       end { case }
2544     end; { inter5 }
2545 
2546   procedure inter6;
2547     begin
2548       case ir.f of
2549         60 : begin    {實數乘}
2550                t := t-1;
2551                s[t].r := s[t].r*s[t+1].r;
2552              end;
2553         61 : begin    {實數除}
2554                t := t-1;
2555                s[t].r := s[t].r/s[t+1].r;
2556              end;
2557         62 : if eof(prd)
2558              then ps := redchk
2559              else readln;
2560         63 : begin
2561                writeln(prr);
2562                lncnt := lncnt+1;
2563                chrcnt := 0;
2564                if lncnt > linelimit
2565                then ps := linchk
2566              end
2567       end { case };
2568     end; { inter6 }
2569   begin { interpret }
2570     s[1].i := 0;
2571     s[2].i := 0;
2572     s[3].i := -1;
2573     s[4].i := btab[1].last;
2574     display[0] := 0;
2575     display[1] := 0;
2576     t := btab[2].vsize-1;
2577     b := 0;
2578     pc := tab[s[4].i].adr;
2579     lncnt := 0;
2580     ocnt := 0;
2581     chrcnt := 0;
2582     ps := run;
2583     fld[1] := 10;
2584     fld[2] := 22;
2585     fld[3] := 10;
2586     fld[4] := 1;
2587     repeat
2588       ir := code[pc];
2589       pc := pc+1;
2590       ocnt := ocnt+1;
2591       case ir.f div 10 of
2592         0 : inter0;
2593         1 : inter1;
2594         2 : inter2;
2595         3 : inter3;
2596         4 : inter4;
2597         5 : inter5;
2598         6 : inter6;
2599       end; { case }
2600     until ps <> run;
2601 
2602     if ps <> fin
2603     then begin
2604            writeln(prr);
2605            write(prr, ' halt at', pc :5, ' because of ');
2606            case ps of    {根據不一樣的錯誤信息來進行報錯}
2607              caschk  : writeln(prr,'undefined case');
2608              divchk  : writeln(prr,'division by 0');
2609              inxchk  : writeln(prr,'invalid index');
2610              stkchk  : writeln(prr,'storage overflow');
2611              linchk  : writeln(prr,'too much output');
2612              lngchk  : writeln(prr,'line too long');
2613              redchk  : writeln(prr,'reading past end or file');
2614            end;
2615            h1 := b;
2616            blkcnt := 10;    { post mortem dump }
2617            repeat
2618              writeln( prr );
2619              blkcnt := blkcnt-1;
2620              if blkcnt = 0
2621              then h1 := 0;
2622              h2 := s[h1+4].i;
2623              if h1 <> 0
2624              then writeln( prr, '',tab[h2].name, 'called at', s[h1+1].i:5);
2625              h2 := btab[tab[h2].ref].last;
2626              while h2 <> 0 do
2627                with tab[h2] do
2628                  begin
2629                    if obj = vvariable
2630                    then if typ in stantyps
2631                         then begin
2632                                write(prr,'',name,'=');
2633                                if normal
2634                                then h3 := h1+adr
2635                                else h3 := s[h1+adr].i;
2636                                case typ of
2637                                  ints : writeln(prr,s[h3].i);
2638                                  reals: writeln(prr,s[h3].r);
2639                                  bools: if s[h3].b
2640                                         then writeln(prr,'true')
2641                                         else writeln(prr,'false');
2642                                  chars: writeln(prr,chr(s[h3].i mod 64 ))
2643                                end
2644                              end;
2645                    h2 := link
2646                  end;
2647              h1 := s[h1+3].i
2648            until h1 < 0
2649          end;
2650     writeln(prr);
2651     writeln(prr,ocnt,' steps');
2652   end; { interpret }
2653 
2654 
2655 
2656 procedure setup;    {程序運行前的準備過程}
2657   begin
2658     key[1] := 'and       ';    {定義一系列保留字}
2659     key[2] := 'array     ';
2660     key[3] := 'begin     ';
2661     key[4] := 'case      ';
2662     key[5] := 'const     ';
2663     key[6] := 'div       ';
2664     key[7] := 'do        ';
2665     key[8] := 'downto    ';
2666     key[9] := 'else      ';
2667     key[10] := 'end       ';
2668     key[11] := 'for       ';
2669     key[12] := 'function  ';
2670     key[13] := 'if        ';
2671     key[14] := 'mod       ';
2672     key[15] := 'not       ';
2673     key[16] := 'of        ';
2674     key[17] := 'or        ';
2675     key[18] := 'procedure ';
2676     key[19] := 'program   ';
2677     key[20] := 'record    ';
2678     key[21] := 'repeat    ';
2679     key[22] := 'then      ';
2680     key[23] := 'to        ';
2681     key[24] := 'type      ';
2682     key[25] := 'until     ';
2683     key[26] := 'var       ';
2684     key[27] := 'while     ';
2685 
2686     ksy[1] := andsy;    {定義保留字對應的符號}
2687     ksy[2] := arraysy;
2688     ksy[3] := beginsy;
2689     ksy[4] := casesy;
2690     ksy[5] := constsy;
2691     ksy[6] := idiv;
2692     ksy[7] := dosy;
2693     ksy[8] := downtosy;
2694     ksy[9] := elsesy;
2695     ksy[10] := endsy;
2696     ksy[11] := forsy;
2697     ksy[12] := funcsy;
2698     ksy[13] := ifsy;
2699     ksy[14] := imod;
2700     ksy[15] := notsy;
2701     ksy[16] := ofsy;
2702     ksy[17] := orsy;
2703     ksy[18] := procsy;
2704     ksy[19] := programsy;
2705     ksy[20] := recordsy;
2706     ksy[21] := repeatsy;
2707     ksy[22] := thensy;
2708     ksy[23] := tosy;
2709     ksy[24] := typesy;
2710     ksy[25] := untilsy;
2711     ksy[26] := varsy;
2712     ksy[27] := whilesy;
2713 
2714 
2715     sps['+'] := plus;    {定義特殊字符對應的sym}
2716     sps['-'] := minus;
2717     sps['*'] := times;
2718     sps['/'] := rdiv;
2719     sps['('] := lparent;
2720     sps[')'] := rparent;
2721     sps['='] := eql;
2722     sps[','] := comma;
2723     sps['['] := lbrack;
2724     sps[']'] := rbrack;
2725     sps[''''] := neq;
2726     sps['!'] := andsy;
2727     sps[';'] := semicolon;
2728   end { setup };
2729 
2730 procedure enterids;    {這個過程負責將所有標準類型的信息登錄到table中}
2731   begin    
2732     enter('          ',vvariable,notyp,0); { sentinel }
2733     enter('false     ',konstant,bools,0);
2734     enter('true      ',konstant,bools,1);
2735     enter('real      ',typel,reals,1);
2736     enter('char      ',typel,chars,1);
2737     enter('boolean   ',typel,bools,1);
2738     enter('integer   ',typel,ints,1);
2739     enter('abs       ',funktion,reals,0);
2740     enter('sqr       ',funktion,reals,2);
2741     enter('odd       ',funktion,bools,4);
2742     enter('chr       ',funktion,chars,5);
2743     enter('ord       ',funktion,ints,6);
2744     enter('succ      ',funktion,chars,7);
2745     enter('pred      ',funktion,chars,8);
2746     enter('round     ',funktion,ints,9);
2747     enter('trunc     ',funktion,ints,10);
2748     enter('sin       ',funktion,reals,11);
2749     enter('cos       ',funktion,reals,12);
2750     enter('exp       ',funktion,reals,13);
2751     enter('ln        ',funktion,reals,14);
2752     enter('sqrt      ',funktion,reals,15);
2753     enter('arctan    ',funktion,reals,16);
2754     enter('eof       ',funktion,bools,17);
2755     enter('eoln      ',funktion,bools,18);
2756     enter('read      ',prozedure,notyp,1);
2757     enter('readln    ',prozedure,notyp,2);
2758     enter('write     ',prozedure,notyp,3);
2759     enter('writeln   ',prozedure,notyp,4);
2760     enter('          ',prozedure,notyp,0);
2761   end;
2762 
2763 
2764 begin  { main }    
2765   setup;    {初始化變量}
2766   constbegsys := [ plus, minus, intcon, realcon, charcon, ident ];    {常量的開始符號集合}
2767   typebegsys := [ ident, arraysy, recordsy ];    {類型的開始符號集合}
2768   blockbegsys := [ constsy, typesy, varsy, procsy, funcsy, beginsy ];    {分語句的開始符號集合}
2769   facbegsys := [ intcon, realcon, charcon, ident, lparent, notsy ];        {因子的開始符號集合}
2770   statbegsys := [ beginsy, ifsy, whilesy, repeatsy, forsy, casesy ];    {statement開始的符號集合}
2771   stantyps := [ notyp, ints, reals, bools, chars ];    
2772   lc := 0;        {重置pc}
2773   ll := 0;        {重置當前行的長度}
2774   cc := 0;        {重置當前行位置指針}
2775   ch := ' ';    {重置當前符號}
2776   errpos := 0;    {重置錯誤位置}
2777   errs := [];    {重置錯誤集合}
2778   writeln( 'NOTE input/output for users program is console : ' );
2779   writeln;
2780   write( 'Source input file ?');    {代碼輸入文件}
2781   readln( inf );
2782   assign( psin, inf );
2783   reset( psin );
2784   write( 'Source listing file ?');    {代碼輸出文件}
2785   readln( outf );
2786   assign( psout, outf );
2787   rewrite( psout );
2788   assign ( prd, 'con' );
2789   write( 'result file : ' );    {結果輸出文件}
2790   readln( fprr );
2791   assign( prr, fprr );
2792   reset ( prd );
2793   rewrite( prr );
2794 
2795   t := -1;    {設置tab棧頂初值}
2796   a := 0;    {設置atab棧頂初值}
2797   b := 1;    {設置btab棧頂初始值}
2798   sx := 0;    {設置stab棧頂初值}
2799   c2 := 0;    {設置rconst棧頂初值}
2800   display[0] := 1;    {設置display初值}
2801   iflag := false;    {初始化一系列flag的值}
2802   oflag := false;
2803   skipflag := false;
2804   prtables := false;
2805   stackdump := false;
2806 
2807   insymbol;    {得到第一個sym}
2808 
2809   if sy <> programsy    {要求第一個符號是program關鍵字,不是的話就報錯}
2810   then error(3)
2811   else begin
2812          insymbol;    {獲取下一個符號}
2813          if sy <> ident    {應該是程序名,不是則報錯}
2814          then error(2)
2815          else begin
2816                 progname := id;
2817                 insymbol;
2818                 if sy <> lparent
2819                 then error(9)
2820                 else repeat
2821                        insymbol;
2822                        if sy <> ident
2823                        then error(2)
2824                        else begin
2825                               if id = 'input     '
2826                               then iflag := true
2827                               else if id = 'output    '
2828                                    then oflag := true
2829                                    else error(0);
2830                               insymbol
2831                             end
2832                      until sy <> comma;
2833                 if sy = rparent
2834                 then insymbol
2835                 else error(4);
2836                 if not oflag then error(20)
2837               end
2838        end;
2839   enterids;
2840   with btab[1] do
2841     begin
2842       last := t;
2843       lastpar := 1;
2844       psize := 0;
2845       vsize := 0;
2846     end;
2847   block( blockbegsys + statbegsys, false, 1 );
2848   if sy <> period
2849   then error(2);
2850   emit(31);  { halt }
2851   if prtables
2852   then printtables;
2853   if errs = []
2854   then interpret
2855   else begin
2856          writeln( psout );
2857          writeln( psout, 'compiled with errors' );
2858          writeln( psout );
2859          errormsg;
2860        end;
2861   writeln( psout );
2862   close( psout );
2863   close( prr )
2864 end.   

View Code