PL/0与Pascal-S编译器程序详细注释

Posted 2020-08-17

　　学校编译课的作业之一,要求阅读两个较为简单的编译器的代码并做注释, 个人感觉是一次挺有意义的锻炼, 将自己的心得分享出来与一同在进步的同学们分享. 今后有时间再做进一步的更新和总结,其中可能有不少错误,也请各位大佬不吝指正. 代码可以通过使用Lazarus等pascal环境执行。

源码仓库：https://github.com/luxiaodou/PL-0-and-Pascal-S-complier-trans

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