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

2023-01-21 11:32:24

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

源码仓库：https://github.com/luxiaodou/Pascal-S-and-PL0-complier-comments

PL0编译器源码

PL0语言是Pascal的一个子集，编译器也比较简单，逐行注释

program pl0 ;  { version 1.0 oct.1989 }

{ PL/0 compiler with code generation }

{    comment by Song Lu

    Department of Computer Science&Engineering BUAA,Nov.2016

}

{常量定义}

const norw = ;          { no. of reserved words }    {保留字的数目}

      txmax = ;        { length of identifier table }    {符号表长度}

      nmax = ;          { max. no. of digits in numbers }    {数字的最大长度}

      al = ;            { length of identifiers }    {标识符的最大长度}

      amax = ;        { maximum address }    {相对地址最大值}

      levmax = ;         { maximum depth of block nesting }     {最大嵌套层数}

      cxmax = ;        { 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[..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 : ..levmax;      { level }    {嵌套层次}

                     a : ..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[..] of char;    {缓冲一行代码}

      a : alfa;    {用来存储symbol的变量}

      code : array[..cxmax] of instruction;    {用来保存编译后的PCODE代码，最大容量为cxmax}

      word : array[..norw] of alfa;    {保留字表}

      wsym : array[..norw] of symbol;    {保留字表中每个保留字对应的symbol类型}

      ssym : array[char] of symbol;        {符号对应的symbol类型}

      mnemonic : array[fct] of    {助记符}

                   packed array[..] of char;

      declbegsys, statbegsys, facbegsys : symset;    {声明开始，表达式开始、项开始的符号集合}

      table : array[..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-, '^', n: );    {报错提示信息，'^'指向出错位置，并提示错误类型}

    err := err+ {错误次数+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 := ;    {将行长度重置}

             cc := ;    {将行指针重置}

             write(cx:,' ');  { print code address }    {输出代码地址，宽度为4}

             while not eoln(fin) do    {当没有到行末时}

               begin

                 ll := ll+;    {将行缓冲区的长度+1}

                 read(fin,ch);    {从文件中读取一个字符到ch中}

                 write(ch);    {控制台输出ch}

                 line[ll] := ch    {把这个字符放到当前行末尾}

               end;

             writeln;    {换行}

             readln(fin);    {源文件读取从下一行开始}

             ll := ll+;    {行长度计数加一}

             line[ll] := ' ' { process end-line }    {行数组最后一个元素为空格}

           end;

      cc := cc+;    {行指针+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 := ;    {标识符指针置零，这个量用来统计标识符长度}

           repeat    {循环}

             if k < al    {如果k的大小小于标识符的最大长度}

             then begin

                   k := k+;    {k++}

                   a[k] := ch    {将ch写入标识符暂存变量a}

                 end;

             getch    {获取下一个字符}

           until not( ch in ['a'..'z',''..'']);    {直到读出的不是数字或字母的时候，标识符结束}

           if k >= kk        { kk : last identifier length }    {若k比kk大}

           then kk := k    {kk记录当前标识符的长度k}

           else repeat    {循环}

                  a[kk] := ' ';        {标识符最后一位为空格}

                  kk := kk-    {k--}

               until kk = k;    {直到kk等于当前标识符的长度，这样做的意义是防止上一个标识符存在a中的内容影响到当前标识符，比如上一个标识符为“qwerty”，现在的标识符为“abcd”，如果不清后几位则a中会保存"abcdty"，这显然是错误的}

           id := a;    {id保存标识符名}

           i := ;    {i指向第一个保留字}

           j := norw;   { binary search reserved word table }    {二分查找保留字表，将j设为保留字的最大数目}

           repeat

             k := (i+j) div ;    {再次用到k，但这里只是作为二分查找的中间变量}

             if id <= word[k]    {若当前标识符小于或等于保留字表中的第k个，这里的判断依据的是字典序，那么我们可以推测符号表是按照字典序保存的}

             then j := k-;        {j = k-1}

             if id >= word[k]    {若当前标识符大于或等于保留字表中的第k个}

             then i := k+        {i = k+1}

           until i > j;        {查找结束条件}

           if i- > j    {找到了}

           then sym := wsym[k]    {将找到的保留字类型赋给sym}

           else sym := ident    {未找到则把sym置为ident类型，表示是标识符}

         end

    else if ch in [''..'']    {如果字符是数字}

         then begin  { number }

                k := ;    {这里的k用来记录数字的位数}

                num := ;    {num保存数字}

                sym := number;    {将标识符设置为数字}

                repeat    {循环开始}

                  num := *num+(ord(ch)-ord(''));    {将数字字符转换为数字并拼接起来赋给num}

                  k := k+;    {k++}

                  getch    {继续读字符}

                until not( ch in [''..'']);    {直到输入的不再是数字}

                if k > nmax    {如果数字的位数超过了数字允许的最大长度}

                then error()    {报错}

              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+    {将当前代码行数之计数加一}

  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+;    {符号表序号加一,指向一个空表项}

      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号错误}

                            num :=     {将常量置零}

                           end;

                      val := num    {val保存该常量的值,结合上句可以看出,如果超过限制则保存0}

                    end;

            variable : begin    {对变量}

                      level := lev;    {记录所属层次}

                      adr := dx;    {记录变量在当前层中的偏移量}

                      dx := dx+    {偏移量+1,位下一次插入做准备}

                    end;

            prosedure: level := lev;    {对过程,记录所属层次}

          end

        end

    end; { enter }

function position ( id : alfa ): integer;    {查找符号表的函数,输入id为需要寻找的符号,}

  var i : integer;    {声明记录变量}

  begin

    table[].name := id;    {把id放到符号表0号位置}

    i := tx;    {将i设置为符号表的最后一个位置,因为符号表是栈式结构,因此按层次逆序查找}

    while table[i].name <> id do    {如果当前表项的name和id不同}

       i := i-;    {再向前找}

    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();    {报一号错误,因为声明应该使用等号}

                    getsym;  {获取下一个sym类型}

                    if sym = number    {如果读到的是数字}

                    then begin

                           enter(constant);    {将该常量入表}

                           getsym    {获取下一个sym类型}

                         end

                    else error()    {如果等号后面不是数字,报2号错误}

                  end

             else error()    {如果常量标识符后面接的不是等号或赋值符号,报三号错误}

           end

      else error()    {如果常量声明第一个符号不是标识符,报4号错误}

    end; { constdeclaration }    {常量声明结束}

  procedure vardeclaration;     {变量声明过程}

    begin

      if sym = ident    {变量声明要求第一个sym为标识符}

      then begin

             enter(variable);    {将该变量入表}

             getsym    {获取下一个sym类型}

           end

      else error()    {如果第一个sym不是标识符,抛出4号错误}

    end; { vardeclaration }

  procedure listcode;    {列出PCODE的过程}

    var i : integer;    {声明计数变量}

    begin

      for i := cx0 to cx- do    {所有生成的代码}

        with code[i] do    {对于每一行代码}

          writeln( i:, mnemonic[f]:,l:, a:)    {格式化输出,分别输出序号,指令的助记符,层次,地址.实际的输出效果和我们实际的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,  );    {测试单词的合法性,判别当前sym是否在facbegsys中,后者在main中定义,如果不在报24号错误}

              while sym in facbegsys do    {循环处理因子}

                begin

                  if sym = ident    {如果识别到标识符}

                  then begin

                         i := position(id);    {查表,记录其在符号表中的位置,保存至i}

                         if i=     {如果i为0,表示没查到}

                         then error()    {报11号错误}

                         else

                           with table[i] do    {对第i个表项的内容}

                             case kind of        {按照表项的类型执行不同的操作}

                               constant : gen(lit,,val);    {如果是常量类型,生成lit指令,操作数为0,val}

                               variable : gen(lod,lev-level,adr);    {如果是变量类型,生成lod指令,操作数为lev-level,adr}

                               prosedure: error()    {如果因子处理中识别到了过程标识符,报21号错误}

                             end;

                         getsym    {获取下一个sym类型}

                       end

                  else if sym = number    {如果识别到数字}

                       then begin

                            if num > amax    {判别数字是否超过规定上限}

                            then begin

                                   error();    {超过上限,报30号错误}

                                   num :=     {将数字重置为0}

                                 end;

                            gen(lit,,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号错误}

                               end;

                test(fsys,[lparen],)    {测试结合是否在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,, )    {生成opr指令,乘法指令}

              else gen( opr,,)    {生成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,,)    {生成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,,)    {生成opr指令,完成加法运算}

            else gen( opr,,)    {否则生成减法指令}

          end

      end; { expression }

    procedure condition( fsys : symset );     {条件处理过程}

      var relop : symbol;    {临时变量}

      begin

        if sym = oddsym    {如果当天符号是odd运算符}

        then begin

               getsym;    {获取下一个sym类型}

               expression(fsys);    {调用表达式分析过程}

               gen(opr,,)    {生成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号错误}

               else begin

                      relop := sym;    {记录当前符号类型}

                      getsym;    {获取下一个sym类型}

                      expression(fsys);    {调用表达式分析过程对表达式进行分析}

                      case relop of    {根据当前符号类型不同完成不同的操作}

                        eql : gen(opr,,);    {如果是等号,生成opr8号指令,判断是否相等}

                        neq : gen(opr,,);    {如果是不等号,生成opr9号指令,判断是否不等}

                        lss : gen(opr,,);    {如果是小于号,生成opr10号指令,判断是否小于}

                        geq : gen(opr,,);    {如果是大于等于号,生成opr11号指令,判断是否大于等于}

                        gtr : gen(opr,,);    {如果是大于号,生成opr12号指令,判断是否大于}

                        leq : gen(opr,,);    {如果是小于等于号,生成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则是没找到}

             then error()    {抛出11号错误}

             else if table[i].kind <> variable    {如果在符号表中找到了该符号,但该符号的类型不是变量}

                  then begin { giving value to non-variation }    {那么现在的操作属于给非变量赋值}

                         error();    {报12号错误}

                         i :=     {将符号表标号置零}

                       end;

             getsym;    {获取下一个sym类型}

             if sym = becomes    {如果读到的是赋值符号}

             then getsym    {获取下一个sym类型}

             else error();    {如果读到的不是赋值符号,报13号错误}

             expression(fsys);    {赋值符号的后面可以跟表达式,因此调用表达式处理子程序}

             if i <>     {如果符号表中找到了合法的符号}

             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号错误}

             else begin    {如果没有报错}

                    i := position(id);    {记录当前符号在符号表中的位置}

                    if i =     {如果没有找到}

                    then error()    {报11号错误}

                    else    {如果找到了}

                      with table[i] do    {对第i个表项做如下操作}

                        if kind = prosedure    {如果该表项的种类为过程}

                        then gen(cal,lev-level,adr)    {生成cal代码用来实现call操作}

                        else error();    {如果种类不为过程类型,报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();    {如果条件后面接的不是then,报16号错误}

                  cx1 := cx;    {记录当前的生成代码位置}

                  gen(jpc,,);    {生成条件跳转指令,跳转位置暂填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号错误}

                           statement([semicolon,endsym]+fsys)    {继续分析}

                         end;

                       if sym = endsym    {如果读到了end关键字}

                       then getsym    {获取下一个sym类型}

                       else error()    {报17号错误}

                     end

                else if sym = whilesym    {如果读到了while关键字}

                     then begin

                            cx1 := cx;    {记录当前生成代码的行数指针}

                            getsym;    {获取下一个sym类型}

                            condition([dosym]+fsys);    {因为while后需要添加循环条件,因此调用条件语句的分析过程}

                            cx2 := cx;    {记录在分析完条件之后的生成代码的位置,也是do开始的位置}

                            gen(jpc,,);    {生成一个条件跳转指令,但是跳转位置(a)置零}

                            if sym = dosym    {条件后应该接do关键字}

                            then getsym    {获取下一个sym类型}

                            else error();    {如果没接do,报18号错误}

                            statement(fsys);    {分析处理循环节中的语句}

                            gen(jmp,,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 =     {如果i为0,说明符号表中没有找到id对应的符号}

                                        then error()    {报11号错误}

                                        else if table[i].kind <> variable {如果找到了,但该符号的类型不是变量}

                                             then begin

                                                    error();    {报12号错误,不能像常量和过程赋值}

                                                    i :=     {将i置零}

                                                  end

                                             else with table[i] do    {如果是变量类型}

                                                   gen(red,lev-level,adr)    {生成一条red指令,读取数据}

                                     end

                                 else error();    {如果左括号后面跟的不是标识符,报4号错误}

                                 getsym;    {获取下一个sym类型}

                               until sym <> comma    {知道现在的符号不是都好,循环结束}

                             else error();    {如果read后面跟的不是左括号,报40号错误}

                             if sym <> rparen    {如果上述内容之后接的不是右括号}

                             then error();    {报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,,);    {生成一个wrt海曙，用来输出内容}

                                 until sym <> comma;    {知道读取到的sym不是逗号}

                                 if sym <> rparen    {如果内容结束没有右括号}

                                 then error();    {报22号错误}

                                 getsym    {获取下一个sym类型}

                               end

                          else error()    {如果write后面没有跟左括号}

                        end;

      test(fsys,[],)    {测试当前字符是否合法,如果没有出现在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是因为需要预留SL,DL,RA的空间}

    tx0 := tx;    {记录当前符号表的栈顶位置}

    table[tx].adr := cx;    {符号表当前位置的偏移地址记录下一条生成代码开始的位置}

    gen(jmp,,); { jump from declaration part to statement part }    {产生一条jmp类型的无条件跳转指令,跳转位置未知}

    if lev > levmax    {当前过程所处的层次大于允许的最大嵌套层次}

    then error();    {报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号错误}

             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号错误}

             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号错误}

          if sym = semicolon    {如果读到了分号,说明proc声明结束}

          then getsym    {获取下一个sym类型}

          else error();    {如果声明过程之后没有跟分号,报5号错误}

          block(lev+,tx,[semicolon]+fsys);    {执行分程序的分析过程}

          if sym = semicolon    {递归调用返回后应该接分号}

          then begin    {如果接的是分号}

                 getsym;    {获取下一个sym类型}

                 test( statbegsys+[ident,procsym],fsys,)    {测试当前的sym是否合法}

               end

          else error()    {如果接的不是分号,报5号错误}

        end;

      test( statbegsys+[ident],declbegsys,)    {测试当前的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,,dx); { topstack point to operation area }    {生成int指令,分配dx个空间}

    statement( [semicolon,endsym]+fsys);    {调用语法分析程序}

    gen(opr,,); { return }    {生成0号gen程序,完成返回操作}

    test( fsys, [], );    {测试当前状态是否合法,有问题报8号错误}

    listcode;    {列出该block所生成的PCODE}

end { block };

procedure interpret;  {解释执行程序}

  const stacksize = ;    {设置栈大小为常量500}

  var p,b,t: integer; { program-,base-,topstack-register }    {设置三个寄存器,分别记录下一条指令,基址地址和栈顶指针}

     i : instruction;{ instruction register }    {指令寄存器,类型为instruction,显然是为了存放当前指令}

     s : array[..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 >  do    {如果层数大于0,即寻找的不是本层}

        begin

          b1 := s[b1];    {记录当前层数据基址的内容}

          l := l-    {层数--}

        end;

      base := b1    {将找到的基地址保存起来}

    end; { base }

  begin

    writeln( 'START PL/0' );    {输出程序开始运行的提示语句}

    t := ;    {将栈顶指针置零}

    b := ;    {将基址地址置为1}

    p := ;    {将指令寄存器置零}

    s[] := ;    {将数据栈的第一层置零,对应SL}

    s[] := ;    {将数据栈的第二层置零,对应DL}

    s[] := ;    {将数据栈的第三层置零,对应RA}

    repeat    {循环开始}

      i := code[p];    {获取当前需要执行的代码}

      p := p+;        {将指令寄存器+1,以指向下一条置零}

      with i do    {针对当前指令}

        case f of    {不同类型的指令执行不同操作}

          lit : begin    {对lit类型}

                  t := t+;    {栈顶指针加1}

                  s[t]:= a;    {将a操作数的值放入栈顶}

              end;

          opr : case a of { operator }    {针对opr类型的指令}

                   : begin { return }    {0对应return操作}

                        t := b-;    {t取到该层数据栈SL-1的位置,意味着将该层的数据栈全部清空(因为要返回了嘛)}

                        p := s[t+];    {将指令指针指向RA的值,即获得return address}

                        b := s[t+];    {将基址指针指向DL的值,即获得了return之后的基址,因为被调用层次的DL指向调用层次的基址}

                     end;

                   : s[t] := -s[t];    {1对应取反操作}

                   : begin        {2对应求和操作}

                        t := t-;    {栈顶指针退一格}

                        s[t] := s[t]+s[t+]    {将栈顶和次栈顶中的数值求和放入新的栈顶,注意运算后的栈顶是下降一格的,下面的运算亦如此}

                     end;

                   : begin        {3对应做差操作}

                        t := t-;    {栈顶指针退格}

                        s[t] := s[t]-s[t+]    {次栈顶减栈顶,结果放入新的栈顶}

                     end;

                   : begin        {4对应乘积操作}

                        t := t-;    {栈顶退格}

                        s[t] := s[t]*s[t+]    {栈顶和次栈顶相乘,结果放入新的栈顶}

                     end;

                   : begin        {5对应相除}

                        t := t-;    {栈顶退格}

                        s[t] := s[t]div s[t+]    {次栈顶除以栈顶,结果放入新的栈顶}

                     end;

                   : s[t] := ord(odd(s[t]));    {6对应判断是否栈顶数值为奇数}

                   : begin    {8号对应等值判断}

                        t := t-;    {栈顶退格}

                        s[t] := ord(s[t]=s[t+])    {如果栈顶和次栈顶数值相同,栈顶置一,否则置零}

                    end;

                   : begin    {9号对应不等判断}

                        t := t-;    {栈顶退格}

                        s[t] := ord(s[t]<>s[t+])    {如果栈顶和次栈顶数值不同,栈顶置一,否则置零}

                     end;

                  : begin    {10号对应小于判断}

                        t := t-;    {栈顶退格}

                        s[t] := ord(s[t]< s[t+])    {如果次栈顶的数值小于栈顶的数值,栈顶置一,否则置零}

                     end;

                  : begin    {11号对应大于等于判断}

                        t := t-;    {栈顶退格}

                        s[t] := ord(s[t] >= s[t+]) {如果次栈顶的数值大于等于栈顶的数值,栈顶置一,否则置零}

                     end;

                  : begin    {12号对应着大于判断}

                        t := t-;    {栈顶退格}

                        s[t] := ord(s[t] > s[t+])    {如果次栈顶的数值大于栈顶的数值,栈顶置一,否则置零}

                     end;

                  : begin    {13号对应着小于等于判断}

                        t := t-;    {栈顶退格}

                        s[t] := ord(s[t] <= s[t+])    {如果次栈顶的数值小于等于栈顶的数值,栈顶置一,否则置零}

                     end;

                end;

          lod : begin    {如果是lod指令}

                  t := t+;    {栈顶指针指向新栈}

                  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-    {栈顶退栈}

              end;

          cal : begin  { generate new block mark }    {对于指令}

                  s[t+] := base(l);    {由于要生成新的block,因此栈顶压入SL的值}

                  s[t+] := b;    {在SL之上压入当前数据区的基址,作为DL}

                  s[t+] := p;    {在DL之上压入指令指针,即是指令的断点,作为RA}

                  b := t+;    {把当前的数据区基址指向新的SL}

                  p := a;    {从a的位置继续执行程序,a来自instruction结构体}

              end;

          int : t := t+a;    {对int指令,将栈顶指针上移a个位置}

          jmp : p := a;    {对jmp指令,将指令指针指向a}

          jpc : begin    {对于jpc指令}

                  if s[t] =     {如果栈顶数据为零}

                  then p := a;    {则将指令指针指向a}

                  t := t-;    {栈顶向下移动}

              end;

          red : begin    {对red指令}

                  writeln('??:');    {输出提示信息}

                  readln(s[base(l)+a]); {读一行数据,读入到相差l层,层内偏移为a的数据栈中的数据的信息}

              end;

          wrt : begin    {对wrt指令}

                  writeln(s[t]);    {输出栈顶的信息}

                  t := t+    {栈顶上移}

              end

        end { with,case }

    until p = ;    {直到当前指令的指针为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[] := 'begin        '; word[] := 'call         ';

  word[] := 'const        '; word[] := 'do           ';

  word[] := 'end          '; word[] := 'if           ';

  word[] := 'odd          '; word[] := 'procedure    ';

  word[] := 'read         '; word[]:= 'then         ';

  word[]:= 'var          '; word[]:= 'while        ';

  word[]:= 'write        ';    {填写保留字表,注意这里所有字符都预留的相同的长度}

  wsym[] := beginsym;      wsym[] := callsym;

  wsym[] := constsym;      wsym[] := dosym;

  wsym[] := endsym;        wsym[] := ifsym;

  wsym[] := oddsym;        wsym[] := procsym;

  wsym[] := readsym;       wsym[]:= thensym;

  wsym[]:= varsym;        wsym[]:= whilesym;

  wsym[]:= 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 := ;    {将出错的标识符置零}

  cc := ;    {行缓冲指针置零}

  cx := ;    {生成代码行数计数置零}

  ll := ;    {词法分析行缓冲区长度置零}

  ch := ' ';    {当前字符设为' '}

  kk := al;    {kk的值初始化为0}

  getsym;    {获取第一个词的标识符}

  block( ,,[period]+declbegsys+statbegsys );    {执行主程序block}

  if sym <> period    {如果符号不是句号}

  then error();    {报⑨号错误}

  if err =     {如果err为0表示没有错误}

  then interpret    {开始解释执行生成的PCODE代码}

  else write('ERRORS IN PL/0 PROGRAM');    {否则出现了错误,报错}

  writeln;    {换行}

  close(fin);    {关闭源文件程序}

  readln(sfile);    {读取PL/0源程序}

end.

Pascal-S编译器

比PL0的代码多不少，同样是Pascal的子集，选择重要函数注释，将来有时间的话继续补全

 program PASCALS(INPUT,OUTPUT,PRD,PRR);

 {  author:N.Wirth, E.T.H. CH-8092 Zurich,1.3.76 }

 {  modified by R.E.Berry

     Department of computer studies

     UniversitY of Lancaster

     Variants ot this program are used on

     Data General Nova,Apple,and

     Western Digital Microengine machines. }

 {   further modified by M.Z.Jin

     Department of Computer Science&Engineering BUAA,0ct.1989

 }

 {    comment by Song Lu

     Department of Computer Science&Engineering BUAA,Nov.2016

 }

 const nkw = ;    { no. of key words }    {key word应当理解为保留字}

       alng = ;   { no. of significant chars in identifiers }

       llng = ;  { input line length }

       emax = ;  { max exponent of real numbers }

       emin = -; { min exponent }

       kmax = ;   { max no. of significant digits }

       tmax = ;  { size of table }

       bmax = ;   { size of block-talbe }

       amax = ;   { size of array-table }

       c2max = ;  { size of real constant table }

       csmax = ;  { max no. of cases }

       cmax = ;  { size of code }

       lmax = ;    { maximum level }

       smax = ;  { size of string-table }

       ermax = ;  { max error no. }    {最大错误数量}

       omax = ;   { highest order code }

       xmax = ;  { 2**15-1 }    {index的范围}

       nmax = ;  { 2**15-1 }    {数字的范围}

       lineleng = ; { output line length }

       linelimit = ;    {行数限制}

       stacksize = ;    {数据栈大小}

 type symbol = ( intcon, realcon, charcon, stringcon,

                 notsy, plus, minus, times, idiv, rdiv, imod, andsy, orsy,

                 eql, neq, gtr, geq, lss, leq,

                 lparent, rparent, lbrack, rbrack, comma, semicolon, period,

                 colon, becomes, constsy, typesy, varsy, funcsy,

                 procsy, arraysy, recordsy, programsy, ident,

                 beginsy, ifsy, casesy, repeatsy, whilesy, forsy,

                 endsy, elsesy, untilsy, ofsy, dosy, tosy, downtosy, thensy);

      index = -xmax..+xmax;

      alfa = packed array[..alng]of char;

      objecttyp = (konstant, vvariable, typel, prozedure, funktion );

      types = (notyp, ints, reals, bools, chars, arrays, records );

      symset = set of symbol;

      typset = set of types;

      item = record

                typ: types;

                ref: index;

             end;

      order = packed record

                f: -omax..+omax;

                x: -lmax..+lmax;

                y: -nmax..+nmax

             end;

 var  ch:         char; { last character read from source program }

      rnum:       real; { real number from insymbol }

      inum:       integer;     { integer from insymbol }

      sleng:      integer;     { string length }

      cc:         integer;     { character counter }

      lc:         integer;     { program location counter }

      ll:         integer;     { length of current line }

      errpos:     integer;

      t,a,b,sx,c1,c2:integer;  { indices to tables }

      iflag, oflag, skipflag, stackdump, prtables: boolean;

      sy:         symbol;      { last symbol read by insymbol }

      errs:       set of ..ermax;    {记录错误的集合}

      id:         alfa;        { identifier from insymbol }

      progname:   alfa;

      stantyps:   typset;

      constbegsys, typebegsys, blockbegsys, facbegsys, statbegsys: symset;

      line:       array[..llng] of char;

      key:        array[..nkw] of alfa;        {保留字集合}

      ksy:        array[..nkw] of symbol;    {保留字对应的sym集合}

      sps:        array[char]of symbol;  { special symbols }

      display:    array[..lmax] of integer;

      tab:        array[..tmax] of      { indentifier lable }    {符号表}

                  packed record

                      name: alfa;

                      link: index;

                      obj:  objecttyp;

                      typ:  types;

                      ref:  index;

                      normal: boolean;

                      lev:  ..lmax;

                      adr: integer

                  end;

      atab:       array[..amax] of    { array-table }    {数组信息向量表}

                  packed record

                      inxtyp,eltyp: types;

                      elref,low,high,elsize,size: index

                  end;

      btab:       array[..bmax] of    { block-table }    {分符号表}

                  packed record

                      last, lastpar, psize, vsize: index

                  end;

      stab:       packed array[..smax] of char; { string table }    {字符串常量表}

      rconst:     array[..c2max] of real;    {实常量表}

      code:       array[..cmax] of order;    {P代码表}

      psin,psout,prr,prd:text;      { default in pascal p }    {写入inf,outf,fppr文件的文本}

      inf, outf, fprr: string;    {代码输入,代码输出,结果输出的文件路径}

 procedure errormsg;    {打印错误信息摘要的过程}

   var k : integer;

      msg: array[..ermax] of alfa;    {给定错误信息表,最多ermax种错误}

   begin

     msg[] := 'undef id  ';    msg[] := 'multi def ';    {给定错误类型'k',及其提示信息}

     msg[] := 'identifier';    msg[] := 'program   ';

     msg[] := ')         ';    msg[] := ':         ';

     msg[] := 'syntax    ';    msg[] := 'ident,var ';

     msg[] := 'of        ';    msg[] := '(         ';

     msg[] := 'id,array  ';    msg[] := '(         ';

     msg[] := ']         ';    msg[] := '..        ';

     msg[] := ';         ';    msg[] := 'func. type';

     msg[] := '=         ';    msg[] := 'boolean   ';

     msg[] := 'convar typ';    msg[] := 'type      ';

     msg[] := 'prog.param';    msg[] := 'too big   ';

     msg[] := '.         ';    msg[] := 'type(case)';

     msg[] := 'character ';    msg[] := 'const id  ';

     msg[] := 'index type';    msg[] := 'indexbound';

     msg[] := 'no array  ';    msg[] := 'type id   ';

     msg[] := 'undef type';    msg[] := 'no record ';

     msg[] := 'boole type';    msg[] := 'arith type';

     msg[] := 'integer   ';    msg[] := 'types     ';

     msg[] := 'param type';    msg[] := 'variab id ';

     msg[] := 'string    ';    msg[] := 'no.of pars';

     msg[] := 'real numbr';    msg[] := 'type      ';

     msg[] := 'real type ';    msg[] := 'integer   ';

     msg[] := 'var,const ';    msg[] := 'var,proc  ';

     msg[] := 'types(:=) ';    msg[] := 'typ(case) ';

     msg[] := 'type      ';    msg[] := 'store ovfl';

     msg[] := 'constant  ';    msg[] := ':=        ';

     msg[] := 'then      ';    msg[] := 'until     ';

     msg[] := 'do        ';    msg[] := 'to downto ';

     msg[] := 'begin     ';    msg[] := 'end       ';

     msg[] := 'factor';

     writeln(psout);    {向文件中打印一个空行}

     writeln(psout,'key words');    {向psout文件中输出'key words',并换行}

     k := ;

     while errs <> [] do    {如果还有错误信息没有处理}

       begin

         while not( k in errs )do k := k + ;    {如果不存在第k种错误,则判断是否存在地k+1中}

         writeln(psout, k, ' ', msg[k] );    {在文件中输出错误的编号及其信息}

         errs := errs - [k]    {将错误集合中的该类错误去除(因为已经处理过)}

     end { while errs }    {循环直到所有错误被处理}

   end { errormsg } ;

 procedure endskip;    {源程序出错后再整个跳过部分代码下面画下划线}

   begin                 { underline skipped part of input }

     while errpos < cc do

       begin

         write( psout, '-');

         errpos := errpos +

       end;

     skipflag := false

   end { endskip };

 procedure nextch;  { read next character; process line end }

   begin

     if cc = ll    {如果读到了一行的末尾}

     then begin

            if eof( psin )    {文件读完了}

            then begin

                   writeln( psout );    {写输出文件}

                   writeln( psout, 'program incomplete' );    {提示信息}

                   errormsg;    {输出错误提示信息到list文件}

                   exit;

                 end;

            if errpos <>     {说明有错误,开始错误处理}

            then begin

                   if skipflag then endskip;    {跳过错误代码}

                   writeln( psout );

                   errpos :=

                 end;

            write( psout, lc: , ' ');    {没有错误执行的操作,在list文件中输出当前PCODE的行数以及一个空格,不换行}

            ll := ;    {将行长度和行指针置零}

            cc := ;

            while not eoln( psin ) do    {如果文件没有读完,读下一行}

              begin

                ll := ll + ;    {统计行的长度}

                read( psin, ch );    {读取下一个字符}

                write( psout, ch );    {输出到list文件中}

                line[ll] := ch    {将ch保存到line中,循环结束line保存下一行代码的所有信息}

              end;

            ll := ll + ;

            readln( psin );

            line[ll] := ' ';    {一行的末尾置为空格}

            writeln( psout );

          end;

      cc := cc + ;    {行指针前移}

      ch := line[cc];    {取词}

   end { nextch };

 procedure error( n: integer );    {打印出错位置和出错编号}

 begin

   if errpos =

   then write ( psout, '****' );

   if cc > errpos

   then begin

          write( psout, ' ': cc-errpos, '^', n:);

          errpos := cc + ;

          errs := errs +[n]

       end

 end { error };

 procedure fatal( n: integer );    {打印表格溢出信息,写入数据多于表大小时会终止程序}

   var msg : array[..] of alfa;

   begin

     writeln( psout );

     errormsg;

     msg[] := 'identifier';   msg[] := 'procedures';

     msg[] := 'reals     ';   msg[] := 'arrays    ';

     msg[] := 'levels    ';   msg[] := 'code      ';

     msg[] := 'strings   ';

     writeln( psout, 'compiler table for ', msg[n], ' is too small');

     exit; {terminate compilation }

   end { fatal };

 procedure insymbol;  {reads next symbol}    {取符号方法}

 label ,,;    {定义label,为goto的使用做准备}

   var  i,j,k,e: integer;

   procedure readscale;    {处理实数的指数部分}

     var s,sign: integer;

     begin

       nextch;

       sign := ;    {符号}

       s := ;        {数字}

       if ch = '+'    {如果读到'+',不作处理}

       then nextch

       else if ch = '-'    {如果是'-',符号设为负}

            then begin

                   nextch;

                   sign := -

                 end;

       if not(( ch >= '' )and (ch <= '' ))    {如果符号后面跟的不是数字,报错}

       then error(  )

       else repeat

            s := *s + ord( ord(ch)-ord(''));    {把数字存到s中}

            nextch;

           until not(( ch >= '' ) and ( ch <= '' ));

       e := s*sign + e    {和下面计算中的e结合得到真的e}

     end { readscale };

   procedure adjustscale;    {根据小数位数和指数大小求出数字数值的大小}

     var s : integer;

         d, t : real;

     begin

       if k + e > emax    {当前的位数加上指数如果超上限报错}

       then error()

       else if k + e < emin    {小于最小值}

            then rnum :=     {精度不够了,直接记为零}

       else begin

             s := abs(e);

             t := 1.0;

             d := 10.0;

             repeat

                 while not odd(s) do    {把偶次幂先用平方处理完}

                   begin

                     s := s div ;

                     d := sqr(d)    {sqr表示平方}

                   end;

                 s := s - ;

                 t := d * t    {在乘一下自己,完成1次,即将e分解为2N+1或2N的形式}

             until s = ;    {t此时为10的e次方}

             if e >=

             then rnum := rnum * t    {e大于零就乘10的e次方}

             else rnum := rnum / t    {反之除}

            end

      end { adjustscale };

   procedure options;    {编译选项}

     procedure switch( var b: boolean );    {处理编译选项中的'+''-'号}

       begin

         b := ch = '+';    {判断当前符号是否为'+'并存入b中返回,注意pascal中变量形参传的是地址}

         if not b    {如果不是加号}

         then if not( ch = '-' )    {如果也不是减号}

              then begin { print error message }    {输出错误信息}

                     while( ch <> '*' ) and ( ch <> ',' ) do    {跳过无用符号}

                       nextch;

                   end

              else nextch

         else nextch

       end { switch };

     begin { options  }    {处理编译选项}

       repeat

         nextch;

         if ch <> '*'    {编译选项为*$t+,s+*的形式}

         then begin

                if ch = 't'    {字母t表示与打印相关的操作}

                then begin

                       nextch;

                       switch( prtables )    {根据符号判断是否打印表格}

                     end

                else if ch = 's'    {s表示卸出打印}

                   then begin

                           nextch;

                           switch( stackdump )

                        end;

              end

       until ch <> ','

     end { options };

   begin { insymbol  }

   : while( ch = ' ' ) or ( ch = chr() ) do    {第一个flag立起来了! chr可以获得9号字符,即跳过所有的空格和\t}

        nextch;    { space & htab }

     case ch of

       'a','b','c','d','e','f','g','h','i',

       'j','k','l','m','n','o','p','q','r',

       's','t','u','v','w','x','y','z':

         begin { identifier of wordsymbol }    {如果是字母,开始识别单词}

           k := ;

           id := '          ';

           repeat

             if k < alng    {alng是限定的关键词长度}

             then begin

                    k := k + ;

                    id[k] := ch

                  end;

             nextch

           until not((( ch >= 'a' ) and ( ch <= 'z' )) or (( ch >= '') and (ch <= '' )));

           i := ;

           j := nkw; { binary search }    {二分查表,找到当前id在表中的位置}

           repeat

             k := ( i + j ) div ;

             if id <= key[k]

             then j := k - ;

             if id >= key[k]

             then i := k + ;

           until i > j;

           if i -  > j

           then sy := ksy[k]    {获取当前ID对应的sym}

           else sy := ident    {没有找到即为标识符}

         end;

       '','','','','','','','','','':    {数字开始当做数字识别}

         begin { number }

           k := ;

           inum := ;

           sy := intcon;    {sy设为intcon表示数字}

           repeat

             inum := inum *  + ord(ch) - ord('');    {把整数部分读完,存到inum}

             k := k + ;    {k统计当前数字位数}

             nextch

           until not (( ch >= '' ) and ( ch <= '' ));

           if( k > kmax ) or ( inum > nmax )    {超上限报错}

           then begin

                  error();

                  inum := ;

                  k :=

                end;

           if ch = '.'    {开始读小数}

           then begin

                  nextch;

                  if ch = '.'

                  then ch := ':'

                  else begin

                         sy := realcon;    {sym为实数}

                         rnum := inum;    {rnum存实数的值}

                         e := ;    {指数}

                         while ( ch >= '' ) and ( ch <= '' ) do    {把数字读完}

                           begin

                             e := e - ;

                             rnum := 10.0 * rnum + (ord(ch) - ord(''));    {暂时当做整数存}

                             nextch

                           end;

                         if e =     {小数点后没数字,40号error}

                         then error();

                         if ch = 'e'    {如果是科学计数法}

                         then readscale;    {算e}

                         if e <>  then adjustscale    {算数,rnum存数}

                       end

                 end

           else if ch = 'e'

                then begin

                       sy := realcon;

                       rnum := inum;

                       e := ;

                       readscale;

                       if e <>

                       then adjustscale

                     end;

         end;

       ':':

         begin

           nextch;

           if ch = '='

           then begin

                  sy := becomes;

                  nextch

                end

           else  sy := colon

          end;

       '<':

         begin

           nextch;

           if ch = '='

           then begin

                  sy := leq;

                  nextch

                end

           else

             if ch = '>'

             then begin

                    sy := neq;

                    nextch

                  end

             else  sy := lss

         end;

       '>':

         begin

           nextch;

           if ch = '='

           then begin

                  sy := geq;

                  nextch

                end

           else  sy := gtr

         end;

       '.':

         begin

           nextch;

           if ch = '.'

           then begin

                  sy := colon;    {..居然算作colon冒号}

                  nextch

                end

           else sy := period

         end;

       '''':    {当前字符是否单引号}

         begin

           k := ;

    :     nextch;

           if ch = ''''

           then begin

                  nextch;

                  if ch <> ''''

                  then goto

                end;

           if sx + k = smax

           then fatal();

           stab[sx+k] := ch;

           k := k + ;

           if cc =

           then begin { end of line }

                  k := ;

                end

           else goto ;

    :     if k =     {双引号中间只有一个字符}

           then begin

                  sy := charcon;    {sym类型为字符类型}

                  inum := ord( stab[sx] )    {inum存储该字符的ascii码值}

                end

           else if k =     {空引号,中间没东西}

                then begin

                       error();    {报错}

                       sy := charcon;    {类型字符常量}

                       inum :=     {asc为0}

                     end

           else begin

                   sy := stringcon;    {否则就是一个字符串类型}

                   inum := sx;

                   sleng := k;

                   sx := sx + k

                end

         end;

       '(':

         begin

           nextch;

           if ch <> '*'

           then sy := lparent

           else begin { comment }

                  nextch;

                  if ch = '$'

                  then options;

                  repeat

                    while ch <> '*' do nextch;

                    nextch

                  until ch = ')';

                  nextch;

                  goto

                end

         end;

       '{':

         begin

           nextch;

           if ch = '$'    {左括号加$是进行编译选项的设置}

           then options;

           while ch <> '}' do

             nextch;

           nextch;

           goto

         end;

       '+', '-', '*', '/', ')', '=', ',', '[', ']', ';':    {操作符直接处理}

         begin

           sy := sps[ch];

           nextch

         end;

       '$','"' ,'@', '?', '&', '^', '!':    {单独出现算错}

         begin

           error();

           nextch;

           goto

         end

       end { case }

     end { insymbol };

 procedure enter(x0:alfa; x1:objecttyp; x2:types; x3:integer );    {将当前符号(分程序外的)录入符号表}

   begin

     t := t + ;    { enter standard identifier }

     with tab[t] do

       begin

         name := x0;

         link := t - ;

         obj := x1;

         typ := x2;

         ref := ;

         normal := true;

         lev := ;

         adr := x3;

       end

   end; { enter }

 procedure enterarray( tp: types; l,h: integer );    {将数组信息录入数组表atab}

   begin

     if l > h    {下界大于上界,错误}

     then error();

     if( abs(l) > xmax ) or ( abs(h) > xmax )

     then begin

            error();

            l := ;

            h := ;

          end;

     if a = amax    {表满了}

     then fatal()

     else begin

            a := a + ;

            with atab[a] do

              begin

                inxtyp := tp;    {下标类型}

                low := l;    {上界和下界}

                high := h

              end

          end

   end { enterarray };

 procedure enterblock;    {将分程序登录到分程序表}

   begin

     if b = bmax    {表满了}

     then fatal()    {报错退出}

     else begin

            b := b + ;

            btab[b].last := ;        {指向过程或函数最后一个符号在表中的位置,建表用}

            btab[b].lastpar := ;    {指向过程或者函数的最后一个'参数'符号在tab中的位置,退栈用}

          end

   end { enterblock };

 procedure enterreal( x: real );    {登陆实常量表}

   begin

     if c2 = c2max -

     then fatal()

     else begin

            rconst[c2+] := x;

            c1 := ;

            while rconst[c1] <> x do

              c1 := c1 + ;

            if c1 > c2

            then  c2 := c1

          end

   end { enterreal };

 procedure emit( fct: integer );    {emit和下面两个方法都是用来生成PCODE的,后面接的数字是代表有几个操作数}

   begin

     if lc = cmax

     then fatal();

     code[lc].f := fct;

     lc := lc +

 end { emit };

 procedure emit1( fct, b: integer );

   begin

     if lc = cmax

     then fatal();

     with code[lc] do

       begin

         f := fct;

         y := b;

       end;

     lc := lc +

   end { emit1 };

 procedure emit2( fct, a, b: integer );

   begin

     if lc = cmax then fatal();

     with code[lc] do

       begin

         f := fct;

         x := a;

         y := b

       end;

     lc := lc + ;

 end { emit2 };

 procedure printtables;    {打印表的过程}

   var i: integer;

   o: order;

       mne: array[..omax] of

            packed array[..] of char;

   begin

     mne[] := 'LDA  ';   mne[] := 'LOD  ';  mne[] := 'LDI  ';    {定义PCODE指令符}

     mne[] := 'DIS  ';   mne[] := 'FCT  ';  mne[] := 'INT  ';

     mne[] := 'JMP  ';   mne[] := 'JPC  ';  mne[] := 'SWT  ';

     mne[] := 'CAS  ';   mne[] := 'F1U  ';  mne[] := 'F2U  ';

     mne[] := 'F1D  ';   mne[] := 'F2D  ';  mne[] := 'MKS  ';

     mne[] := 'CAL  ';   mne[] := 'IDX  ';  mne[] := 'IXX  ';

     mne[] := 'LDB  ';   mne[] := 'CPB  ';  mne[] := 'LDC  ';

     mne[] := 'LDR  ';   mne[] := 'FLT  ';  mne[] := 'RED  ';

     mne[] := 'WRS  ';   mne[] := 'WRW  ';  mne[] := 'WRU  ';

     mne[] := 'HLT  ';   mne[] := 'EXP  ';  mne[] := 'EXF  ';

     mne[] := 'LDT  ';   mne[] := 'NOT  ';  mne[] := 'MUS  ';

     mne[] := 'WRR  ';   mne[] := 'STO  ';  mne[] := 'EQR  ';

     mne[] := 'NER  ';   mne[] := 'LSR  ';  mne[] := 'LER  ';

     mne[] := 'GTR  ';   mne[] := 'GER  ';  mne[] := 'EQL  ';

     mne[] := 'NEQ  ';   mne[] := 'LSS  ';  mne[] := 'LEQ  ';

     mne[] := 'GRT  ';   mne[] := 'GEQ  ';  mne[] := 'ORR  ';

     mne[] := 'ADD  ';   mne[] := 'SUB  ';  mne[] := 'ADR  ';

     mne[] := 'SUR  ';   mne[] := 'AND  ';  mne[] := 'MUL  ';

     mne[] := 'DIV  ';   mne[] := 'MOD  ';  mne[] := 'MUR  ';

     mne[] := 'DIR  ';   mne[] := 'RDL  ';  mne[] := 'WRL  ';

     writeln(psout);

     writeln(psout);

     writeln(psout);

     writeln(psout,'   identifiers  link  obj  typ  ref  nrm  lev  adr');

     writeln(psout);

     for i := btab[].last to t do    {}

       with tab[i] do

         writeln( psout, i,' ', name, link:, ord(obj):, ord(typ):,ref:, ord(normal):,lev:,adr:);

     writeln( psout );

     writeln( psout );

     writeln( psout );

     writeln( psout, 'blocks   last  lpar  psze  vsze' );

     writeln( psout );

     for i :=  to b do

        with btab[i] do

          writeln( psout, i:, last:, lastpar:, psize:, vsize: );

     writeln( psout );

     writeln( psout );

     writeln( psout );

     writeln( psout, 'arrays xtyp etyp eref low high elsz size');

     writeln( psout );

     for i :=  to a do

       with atab[i] do

         writeln( psout, i:, ord(inxtyp):, ord(eltyp):, elref:, low:, high:, elsize:, size:);

     writeln( psout );

     writeln( psout );

     writeln( psout );

     writeln( psout, 'code:');

     writeln( psout );

     for i :=  to lc- do

       begin

         write( psout, i: );

         o := code[i];

         write( psout, mne[o.f]:, o.f: );

         if o.f <

         then if o.f <

              then write( psout, o.x:, o.y: )

              else write( psout, o.y: )

         else write( psout, '          ' );

         writeln( psout, ',' )

       end;

     writeln( psout );

     writeln( psout, 'Starting address is ', tab[btab[].last].adr: )

   end { printtables };

 procedure block( fsys: symset; isfun: boolean; level: integer );    {程序分析过程}

   type conrec = record    {这种结构体可以根据不同的type类型来保存不同样式的数据}

                   case tp: types of

                     ints, chars, bools : ( i:integer );

                     reals :( r:real )

               end;

   var dx : integer ;  { data allocation index }

       prt: integer ;  { t-index of this procedure }

       prb: integer ;  { b-index of this procedure }

       x  : integer ;

   procedure skip( fsys:symset; n:integer);    {跳过错误的代码段}

     begin

       error(n);

       skipflag := true;

       while not ( sy in fsys ) do

         insymbol;

       if skipflag then endskip

     end { skip };

   procedure test( s1,s2: symset; n:integer );    {检查当前sym是否合法}

     begin

       if not( sy in s1 )

       then skip( s1 + s2, n )

     end { test };

   procedure testsemicolon;    {检查分号是否合法}

     begin

       if sy = semicolon

       then insymbol

       else begin

              error();

              if sy in [comma, colon]

              then insymbol

            end;

       test( [ident] + blockbegsys, fsys,  )

     end { testsemicolon };

   procedure enter( id: alfa; k:objecttyp );    {将分程序中的某一符号入符号表}

     var j,l : integer;

     begin

       if t = tmax    {表满了报错退出}

       then fatal()

       else begin

              tab[].name := id;

              j := btab[display[level]].last;    {获取指向当前层最后一个标识符在tab表中的位置}

              l := j;

              while tab[j].name <> id do

                j := tab[j].link;

              if j <>     {j不等于0说明此符号已经在符号表中出现过,报1号错误,意味着重复定义了}

              then error()

              else begin    {没重复定义就正常入栈}

                     t := t + ;

                     with tab[t] do    {将符号放入符号表,注意这里并没有给定符号的typ,ref和adr,这三个变量在procedure typ中被处理}

                       begin

                         name := id;    {输入参数之一,符号的名字}

                         link := l;

                         obj := k;    {输入参数之一,符号代表的目标种类(大类)}

                         typ := notyp;

                         ref := ;

                         lev := level;

                         adr := ;

                         normal := false { initial value }

                       end;

                     btab[display[level]].last := t    {更新当前层最后一个标识符}

                   end

            end

     end { enter };

   function loc( id: alfa ):integer;    {查找id在符号表中的位置}

     var i,j : integer;        { locate if in table }

     begin

       i := level;

       tab[].name := id;  { sentinel }

       repeat

         j := btab[display[i]].last;

         while tab[j].name <> id do

           j := tab[j].link;

         i := i - ;

       until ( i <  ) or ( j <>  );

       if j =     {符号没找到,说明之前没声明,报0号错误}

       then error();

       loc := j

     end { loc } ;

   procedure entervariable;    {变量登陆符号表的过程}

     begin

       if sy = ident

       then begin

              enter( id, vvariable );

              insymbol

            end

       else error()

     end { entervariable };

   procedure constant( fsys: symset; var c: conrec );    {处理程序中出现的常量,变量c负责返回该常量的类型和值}

     var x, sign : integer;

     begin

       c.tp := notyp;

       c.i := ;

       test( constbegsys, fsys,  );

       if sy in constbegsys    {如果第一个sym是常量开始的符号,才往下继续分析}

       then begin    {根据不同的符号执行不同的操作,目的就是返回正确的c}

              if sy = charcon    {对字符常量}

              then begin

                     c.tp := chars;    {类型是char}

                     c.i := inum;    {inum存储该字符的ascii码值}

                     insymbol    {获取下一个sym}

                   end

              else begin

                   sign := ;    {不是符号常量}

                   if sy in [plus, minus]

                   then begin

                          if sy = minus

                          then sign := -;    {负号变符号}

                          insymbol

                        end;

                   if sy = ident    {遇到了标识符}

                   then begin

                          x := loc(id);    {找到当前id在表中的位置}

                          if x <>     {找到了}

                          then

                            if tab[x].obj <> konstant    {如果id对应的符号种类不是常量,报错}

                            then error()

                            else begin

                                   c.tp := tab[x].typ;    {获得常量类型}

                                   if c.tp = reals    {对实数和整数采取不同的赋值方法}

                                   then c.r := sign*rconst[tab[x].adr]

                                   else c.i := sign*tab[x].adr

                                 end;

                          insymbol

                        end

                   else if sy = intcon    {遇到整数}

                        then begin

                               c.tp := ints;    {存type存值}

                               c.i := sign*inum;

                               insymbol

                             end

                   else if sy = realcon    {遇到实数}

                         then begin

                                c.tp := reals;

                                c.r := sign*rnum;

                                insymbol

                              end

                   else skip(fsys,)    {跳过无用符号}

                 end;

                 test(fsys,[],)

            end

     end { constant };

 procedure typ( fsys: symset; var tp: types; var rf,sz:integer );    {处理类型说明,返回当前关键词的类型,在符号表中的位置,以及需要占用存储空间的大小}

     var eltp : types;    {元素类型}

         elrf, x : integer;

         elsz, offset, t0, t1 : integer;

     procedure arraytyp( var aref, arsz: integer );    {处理数组类型的子过程}

       var eltp : types;        {记录元素的类型,pascal中一个数组的所有元素的类型必须相同}

          low, high : conrec;    {记录数组编号(index)的上下界}

          elrf, elsz: integer;    {记录ref和size方便返回}

       begin

         constant( [colon, rbrack, rparent, ofsy] + fsys, low );    {获得数组编号的下界}

         if low.tp = reals    {如果下界类型为实型}

         then begin

                error();    {报27号错误}

                low.tp := ints;    {类型为整型}

                low.i :=     {数值设为0}

              end;

         if sy = colon    {下界后面跟'..',类型是colon,constant结束后读入了下一个sym}

         then insymbol    {获得下一个sym}

         else error();    {如果后面跟的不是..,报13号错误}

         constant( [rbrack, comma, rparent, ofsy ] + fsys, high );    {获取数组下表上界}

         if high.tp <> low.tp    {上下界类型不同报错,也就是说上界也必须是整型}

         then begin

                error();    {报27号错误}

                high.i := low.i    {容错,是使得上界等于下界}

              end;

         enterarray( low.tp, low.i, high.i );    {将数组的信息录入到atab中}

         aref := a;    {获取当前数组在atab中的位置}

         if sy = comma    {后面接逗号,说明需要建立多维数组}

         then begin

                insymbol;    {读取下一个字符}

                eltp := arrays;    {数组中的每个元素类型都是数组}

                arraytyp( elrf, elsz )    {递归调用arraytyp处理数组元素}

              end

         else begin

                if sy = rbrack    {遇到右中括号,则index部分声明完毕}

                then insymbol    {获取下一个sym}

                else begin

                       error();    {缺少右中括号}

                       if sy = rparent    {如果是右括号}

                       then insymbol        {容错}

                     end;

                if sy = ofsy        {获取到了of关键字}

                then insymbol    {获取下一个sym}

                else error();    {没有of报8号错}

                typ( fsys, eltp, elrf, elsz )    {处理当前的符号类型}

              end;

              with atab[aref] do    {记录当前数组的信息}

                begin

                  arsz := (high-low+) * elsz;    {计算该数组需要占用的存储空间}

                  size := arsz;    {记录该数组需要占用的存储空间}

                  eltyp := eltp;    {记录数组的元素类型}

                  elref := elrf;    {记录数组在atab中登陆的位置}

                  elsize := elsz        {记录每个元素的大小}

                end

       end { arraytyp };

     begin { typ  }    {类型处理过程开始}

       tp := notyp;    {用以存储变量的类型}

       rf := ;    {用以记录符号在符号表中的位置}

       sz := ;    {用以储存该类型的大小}

       test( typebegsys, fsys,  );    {测试当前符号是否是数组声明的开始符号,如果不是则报10号错误}

       if sy in typebegsys    {如果是数组声明的开始符号}

       then begin

              if sy = ident    {如果现在的符号是标识符}

              then begin

                     x := loc(id);    {查找id在符号表中的位置}

                     if x <>         {如果找到了}

                     then with tab[x] do    {对其对应表项进行操作}

                            if obj <> typel    {标识符的种类不是'种类'(typel)}

                            then error()    {报29号错,因为声明一个变量需要先标明其类型}

                            else begin

                                   tp := typ;    {获得其代表的类型(char,int,real..)}

                                   rf := ref;    {获得其在符号表中的位置}

                                   sz := adr;    {获得其在运行栈中分配的储存单元的相对地址}

                                   if tp = notyp    {如果未定义类型}

                                   then error()    {报30号错}

                                 end;

                     insymbol    {获得下一个sym}

                   end

              else if sy = arraysy    {如果遇到的是数组元素,即声明开头为'array'}

                   then begin

                          insymbol;    {获得下一个sym}

                          if sy = lbrack    {数组元素声明应该从左中括号开始,即表明数组的大小/维度}

                          then insymbol    {获取下一个sym}

                          else begin    {如果不是左中括号开始}

                                 error();    {报11号错误,说明左括号发生错误}

                                 if sy = lparent    {如果找到了左括号,可能是用户输入错误,报错后做容错处理}

                                 then insymbol    {获取下一个sym}

                               end;

                          tp := arrays;    {当前类型设置为数组类型}

                          arraytyp(rf,sz)    {获得数组在atab表中的登陆位置,和数组的大小}

                          end

              else begin { records }    {否则一定是record的类型,因为typebegsys中只包含ident,arraysy和recordsy三种类型}

                     insymbol;    {获取下一个sym}

                     enterblock;    {登陆子程序}

                     tp := records;    {当前类型设置为records类型}

                     rf := b;    {rf指向当前过程在block表中的位置}

                     if level = lmax    {如果当前嵌套层次已经是最大层次了,即不能产生更深的嵌套}

                     then fatal();    {报5号严重错误并终止程序}

                     level := level + ;    {如果还能嵌套,声明程序成功,block的层次是当前层次+1}

                     display[level] := b;    {设置当前层次的display区.建立分层次索引}

                     offset := ;

                     while not ( sy in fsys - [semicolon,comma,ident]+ [endsy] ) do    {end之前都是记录类型变量内的变量声明}

                       begin { field section }    {开始处理record内部的成员变量}

                         if sy = ident    {如果遇到的是标识符}

                         then begin

                                t0 := t;    {获得当前tab指针的位置}

                                entervariable;    {变量入表}

                                while sy = comma do    {同种变量之间通过逗号分隔,未遇到分号则继续读入}

                                  begin

                                    insymbol;    {获得下一个sym}

                                    entervariable    {继续变量入表的过程}

                                  end;

                                if sy = colon    {遇到了冒号,说明这类的变量声明结束了,冒号后面跟变量的类型}

                                then insymbol    {获取sym}

                                else error();    {如果没有遇到逗号或者冒号,则抛出5号错误}

                                t1 := t;        {记录当前tab栈顶符号的位置,至此t0到t1的符号表中并没有填写typ,ref和adr}

                                typ( fsys + [semicolon, endsy, comma,ident], eltp, elrf,elsz );    {递归调用typ来处理记录类型的成员变量,确定各成员的类型,ref和adr(注意对于不同的类型,ref和adr可能表示不同的意义)}

                                while t0 < t1 do    {填写t0到t1中信息缺失的部分,需要注意的是t0~t1都是同一类型的变量,因此size大小是相同的}

                                begin

                                  t0 := t0 + ;    {指针上移}

                                  with tab[t0] do    {修改当前表项}

                                    begin

                                      typ := eltp;    {给typ赋值,eltp来之上面递归调用的typ语句}

                                      ref := elrf;    {给ref赋值}

                                      normal := true;    {给normal标记赋值,所有normal的初值都是false}

                                      adr := offset;    {记录该变量相对于起始地址的位移}

                                      offset := offset + elsz    {获得下一变量的其实地址}

                                    end

                                end

                              end; { sy = ident }

                         if sy <> endsy    {遇到end说明成员声明已经结束了}

                         then begin

                                if sy = semicolon    {end后面需要接分号}

                                then insymbol    {获取下一个sym}

                                else begin    {如果接的不是分号}

                                       error();    {先报个错}

                                       if sy = comma    {如果是逗号做容错处理}

                                       then insymbol    {然后获取下一个sym类型}

                                     end;

                                     test( [ident,endsy, semicolon],fsys, )    {检验当前符号是否合法}

                              end

                       end; { field section }

                     btab[rf].vsize := offset;    {offset存储了当前的局部变量,参数以及display区所占的空间总数,将其记录下来}

                     sz := offset;    {储存其占用空间总数}

                     btab[rf].psize := ;    {该程序块的参数占用空间设为0,因为record类型并不是真正的过程变量,没有参数}

                     insymbol;    {后去下一个sym}

                     level := level -     {record声明结束后退出当前层次}

                   end; { record }

              test( fsys, [], )    {检查当前sym是否合法}

            end;

       end { typ };

   procedure parameterlist; { formal parameter list }    {处理过程或函数说明中的形参,将形参登陆到符号表}

     var tp : types;    {记录类型}

         valpar : boolean;    {记录当前参数是否为值形参(valueparameter)}

         rf, sz, x, t0 : integer;

     begin

       insymbol;    {获得下一个sym}

       tp := notyp;    {初始化类型}

       rf := ;    {初始化符号表位置}

       sz := ;    {初始化元素大小}

       test( [ident, varsy], fsys+[rparent],  );    {检验当前符号是否合法}

       while sy in [ident, varsy] do    {如果当前的符号是标识符或者var关键字}

         begin

           if sy <> varsy    {如果是var关键字}

           then valpar := true    {将valpar标识符设置为真}

           else begin

                  insymbol;    {如果不是标识符,获取下一个sym}

                  valpar := false    {将valpar设置为假}

                end;

           t0 := t;    {记录当前符号表栈顶位置}

           entervariable;    {调用变量入表的子过程,将参数符号放入符号表}

           while sy = comma do    {如果识别到逗号,说明还有同类型的参数,继续放入符号表}

             begin

               insymbol;    {获取下一个sym}

               entervariable;    {将当前sym放入符号表}

             end;

           if sy = colon    {如果识别到冒号,开始处理类型}

           then begin

                  insymbol;    {获取下一个sym,这里应当是类型}

                  if sy <> ident    {如果不是标识符}

                  then error()    {报2号错误}

                  else begin

                         x := loc(id);    {如果是标识符,则寻找其在符号表中的位置}

                         insymbol;    {获取下一个sym}

                         if x <>     {如果在符号表中找到了sym}

                         then with tab[x] do    {对当前表项做操作}

                           if obj <> typel    {如果当前的符号不是类型标识符}

                           then error()    {报29号错误}

                           else begin

                                  tp := typ;    {获取参数的类型}

                                  rf := ref;    {获取参数在当前符号表的位置}

                                  if valpar    {如果是值形参}

                                  then sz := adr    {sz获得当前形参在符号表中的位置}

                                  else sz :=     {否则将sz置为1}

                                end;

                       end;

                  test( [semicolon, rparent], [comma,ident]+fsys,  )    {检验当前符号是否合法,不合法报14号错误}

                  end

           else error();    {如果不是分号,报5号错误}

           while t0 < t do    {t0~t都是同一类型将上面处理的符号中的属性填写完整}

             begin

               t0 := t0 + ;    {获得刚才读到的第一个参数}

               with tab[t0] do    {对当前符号表中的符号做操作}

                 begin

                   typ := tp;    {设置当前符号的类型}

                   ref := rf;    {设置当前符号在符号表中的位置}

                   adr := dx;    {设置形参的相对地址}

                   lev := level;    {设置形参的level}

                   normal := valpar;    {设置当前变量的normal标记}

                   dx := dx + sz    {更新位移量}

                 end

             end;

             if sy <> rparent    {如果声明结束之后不是右括号}

             then begin

                    if sy = semicolon    {而是分号,说明还有需要声明的参数}

                    then insymbol    {获取下一个sym}

                    else begin

                           error();    {否则报14号错误}

                           if sy = comma    {如果是逗号,做容错处理}

                           then insymbol    {接受下一个sym}

                         end;

                         test( [ident, varsy],[rparent]+fsys,)    {检查下面的符号是否是标识符或者变量声明,均不是则报6号错误}

                  end

         end { while };

       if sy = rparent    {参数声明结束后应当用右括号结尾}

       then begin

              insymbol;    {获取下一个符号}

              test( [semicolon, colon],fsys, )    {声明结束后用分号结束或使用冒号声明返回值类型,如果不是这两种符号,报6号错误}

            end

       else error()    {不是右括号结尾,报错}

     end { parameterlist };

   procedure constdec;    {常量声明的处理过程}

     var c : conrec;

     begin

       insymbol;    {获取下一个sym}

       test([ident], blockbegsys,  );    {检查是不是标识符}

       while sy = ident do    {当获得的是标志符的是否做循环}

         begin

           enter(id, konstant);    {入表,类型为konstant表示常量}

           insymbol;

           if sy = eql    {等号}

           then insymbol

           else begin

                  error();

                  if sy = becomes    {赋值符号容错}

                  then insymbol

                end;

           constant([semicolon,comma,ident]+fsys,c);    {获得常量的类型和数值}

           tab[t].typ := c.tp;    {填表}

           tab[t].ref := ;        {常量ref为0}

           if c.tp = reals

           then begin    {实型和整型的操作不同}

                  enterreal(c.r);

                  tab[t].adr := c1;    {实常量的adr保存了其在rconst表中的登陆的位置}

               end

           else tab[t].adr := c.i;

           testsemicolon

         end

     end { constdec };

   procedure typedeclaration;    {处理类型声明}

     var tp: types;

         rf, sz, t1 : integer;

     begin

       insymbol;

       test([ident], blockbegsys, );    {检查获取到的是不是标识符}

       while sy = ident do    {对于是标识符的情况进行操作}

         begin

           enter(id, typel);    {类型的名称的类型入表}

           t1 := t;        {获得符号表顶部指针}

           insymbol;

           if sy = eql    {获取等号}

           then insymbol

           else begin

                  error();

                  if sy = becomes    {赋值符号容错}

                  then insymbol

                end;

           typ( [semicolon,comma,ident]+fsys, tp,rf,sz );    {获得类型变量的类型,在符号表中的位置以及占用空间的大小}

           with tab[t1] do    {将返回值填表}

             begin

               typ := tp;

               ref := rf;

               adr := sz

             end;

           testsemicolon

         end

     end { typedeclaration };

   procedure variabledeclaration;    {处理变量声明}

     var tp : types;

         t0, t1, rf, sz : integer;

     begin

       insymbol;

       while sy = ident do

         begin

           t0 := t;

           entervariable;

           while sy = comma do

             begin

               insymbol;

               entervariable;    {调用变量入表的程序}

             end;

           if sy = colon

           then insymbol

           else error();

           t1 := t;

           typ([semicolon,comma,ident]+fsys, tp,rf,sz );    {获得类型,地址和大小}

           while t0 < t1 do

             begin

               t0 := t0 + ;

               with tab[t0] do    {填表}

                 begin

                   typ := tp;

                   ref := rf;

                   lev := level;

                   adr := dx;

                   normal := true;

                   dx := dx + sz

                 end

             end;

           testsemicolon

         end

     end { variabledeclaration };

   procedure procdeclaration;    {处理过程声明}

     var isfun : boolean;

     begin

       isfun := sy = funcsy;

       insymbol;

       if sy <> ident

       then begin

              error();

              id :='          '

            end;

       if isfun    {函数和过程使用不同的kind类型}

       then enter(id,funktion)

       else enter(id,prozedure);

       tab[t].normal := true;

       insymbol;

       block([semicolon]+fsys, isfun, level+ );    {过程的处理直接调用block}

       if sy = semicolon

       then insymbol

       else error();

       emit(+ord(isfun)) {exit}    {推出过程/函数}

     end { proceduredeclaration };

 procedure statement( fsys:symset );

     var i : integer;

   procedure expression(fsys:symset; var x:item); forward;    {处理表达式的子程序,由x返回结果,forward使得selector可以调用expression}

     procedure selector(fsys:symset; var v:item);    {处理结构变量:数组下标或记录成员变量}

     var x : item;

         a,j : integer;

     begin { sy in [lparent, lbrack, period] }    {当前的符号应该是左括号,做分号或句号之一}

       repeat

         if sy = period    {如果当前的符号是句号,因为引用成员变量的方式为'记录名.成员名',因此识别到'.'之后应该开始处理后面的结构名称}

         then begin

                insymbol; { field selector }    {处理成员变量}

                if sy <> ident    {如果获取到的不是标识符}

                then error()    {报2号错误}

                else begin

                       if v.typ <> records    {如果处理的不是记录类型}

                       then error()    {报31号错误}

                       else begin { search field identifier }    {在符号表中寻找类型标识符}

                              j := btab[v.ref].last;        {获得该结构体在符号表中最后一个符号的位置}

                              tab[].name := id;    {暂存当前符号的id}

                              while tab[j].name <> id do    {在符号表中寻找当前符号}

                                j := tab[j].link;    {没对应上则继续向前找}

                              if j =     {在当前层(记录中)没找到对应的符号,符号未声明}

                              then error();    {报0号错误}

                              v.typ := tab[j].typ;    {找到了则获取属性}

                              v.ref := tab[j].ref;    {记录其所在的btab位置}

                              a := tab[j].adr;    {记录该成员变量相对于记录变量起始地址的位移}

                              if a <>     {如果位移不为零}

                              then emit1(,a)    {生成一条指令来计算此位移}

                            end;

                       insymbol    {获取下一个sym}

                     end

              end

         else begin { array selector }    {处理数组下表}

                if sy <> lbrack    {如果下表不是左括号开头}

                then error();    {报11号错误}

                repeat    {循环,针对多维数组}

                  insymbol;    {获取下一个sym}

                  expression( fsys+[comma,rbrack],x);    {递归调用处理表达式的过程处理数组下标,获得返回结果保存到x中}

                  if v.typ <> arrays    {如果传入的类型不是数组}

                  then error()    {报22号错误}

                  else begin

                         a := v.ref;    {获得该数组在atab中的位置}

                         if atab[a].inxtyp <> x.typ    {如果传入的下标和数组规定的下标类型不符}

                         then error()    {报26号错误}

                         else if atab[a].elsize =     {如果是变量形参}

                              then emit1(,a)    {进行寻址操作}

                         else emit1(,a);    {对值形参也进行寻址操作}

                         v.typ := atab[a].eltyp;    {获得当前数组元素的类型}

                         v.ref := atab[a].elref    {获得数组元素在atab中的位置}

                       end

                until sy <> comma;    {如果读到的不是逗号,说明没有更高维的数组}

                if sy = rbrack    {如果读到右中括号}

                then insymbol    {读取下一个sym}

                else begin

                       error();    {没读到右中括号则报12号错误}

                       if sy = rparent    {如果读到了右括号,做容错处理}

                       then insymbol    {读取下一个sym}

                    end

              end

       until not( sy in[lbrack, lparent, period]);    {循环直到所有子结构(数组下标或者记录)都被识别完位置}

       test( fsys,[],)    {检测当前的符号是否合法}

     end { selector };

     procedure call( fsys: symset; i:integer );    {处理非标准过程和函数调用的方法,其中i表示需要调用的过程或函数名在符号表中的位置}

        var x : item;

           lastp,cp,k : integer;

        begin

         emit1(,i); { mark stack }    {生成标记栈指令,传入被调用过程或函数在tab表中的位置,建立新的内务信息区}

         lastp := btab[tab[i].ref].lastpar;    {记录当前过程或函数最后一个参数在符号表中的位置}

         cp := i;    {记录被调用过程在符号表中的位置}

         if sy = lparent    {如果是识别到左括号}

         then begin { actual parameter list }    {开始处理参数}

                repeat    {开始循环}

                  insymbol;    {获取参数的sym}

                  if cp >= lastp    {如果当前符号的位置小于最后一个符号的位置,说明还有参数没有处理,反之是错误的}

                  then error()    {报39号错误}

                  else begin    {开始处理参数}

                         cp := cp + ;    {将cp指针向上移动一格}

                         if tab[cp].normal    {如果normal的值为真,即如果传入的是值形参或者其他参数}

                         then begin { value parameter }    {开始处理值形参}

                                expression( fsys+[comma, colon,rparent],x);    {递归调用处理表达式的过程处理参数}

                                if x.typ = tab[cp].typ    {如果参数的类型和符号表中规定的类型相同}

                                then begin

                                       if x.ref <> tab[cp].ref    {如果表达式指向的btab和符号表中所记录的btab不同}

                                       then error()    {报36号错误}

                                       else if x.typ = arrays    {如果遇到了数组类型}

                                            then emit1(,atab[x.ref].size)    {生成装入块指令,将实参表达式的值或地址放到预留的参数单元中}

                                       else if x.typ = records    {如果遇到了记录类型}

                                            then emit1(,btab[x.ref].vsize)    {同样生成装入块指令完成操作,只是细节有所不同}

                                     end

                                else if ( x.typ = ints ) and ( tab[cp].typ = reals )    {如果表达式的类型是整型,但是要求是输入的是实型参数}

                                     then emit1(,)    {生成26号指令,进行类型转换}

                                else if x.typ <> notyp    {如果没有获取到表达式的类型}

                                     then error();    {报36号错,参数类型异常}

                              end

                         else begin { variable parameter }    {如果是变量形参}

                                if sy <> ident    {变量形参应该先识别到标识符}

                                then error()    {若不是标识符开头,报2号错}

                                else begin    {如果是标识符开头}

                                       k := loc(id);    {找到当前id在表中的位置}

                                       insymbol;    {获取下一个符号}

                                       if k <>         {在符号表中找到了id}

                                       then begin

                                              if tab[k].obj <> vvariable    {如果获取到的形参类型不是变量类型}

                                              then error();    {报37号错}

                                              x.typ := tab[k].typ;    {否则记录当前的符号类型}

                                              x.ref := tab[k].ref;    {记录当前参数指向的btab的位置}

                                              if tab[k].normal    {如果是值形参}

                                              then emit2(,tab[k].lev,tab[k].adr)    {将变量地址装入栈顶}

                                              else emit2(,tab[k].lev,tab[k].adr);    {将变量的值装入栈顶(对应变量形参)}

                                              if sy in [lbrack, lparent, period]    {如果后面跟的可以是做中括号(数组下标),左括号(容错)或句号(对应记录)}

                                              then

                                               selector(fsys+[comma,colon,rparent],x);    {调用分析子结构的过程来处理}

                                              if ( x.typ <> tab[cp].typ ) or ( x.ref <> tab[cp].ref )    {如果参数的符号类型或所在表中的位置和符号表中记录的不同}

                                              then error()    {报36号错误}

                                           end

                                    end

                             end {variable parameter }

                       end;

                  test( [comma, rparent],fsys,)    {检查当前sym是否合法}

                until sy <> comma;    {直到出现的不是都好,说明参数声明结束了}

                if sy = rparent    {补齐右括号}

                then insymbol    {获取下一个sym}

                else error()    {没有右括号,报4号错误}

              end;

         if cp < lastp    {如果当前符号的位置没有到达最后一个符号的位置}

         then error(); { too few actual parameters }    {报39号错误,说明符号没有处理完}

         emit1(,btab[tab[i].ref].psize- );    {生成19号CAL指令,正式开始过程或函数调用}

         if tab[i].lev < level    {如果符号所在层次小于当前层次}

         then emit2(,tab[i].lev, level )    {更新display区}

       end { call };

     function resulttype( a, b : types) :types;    {处理整型或实型两个操作数运算时的类型转换}

       begin

         if ( a > reals ) or ( b > reals )    {如果有操作数超过上限报33号错误}

         then begin

                error();

                resulttype := notyp    {返回nottype}

              end

         else if ( a = notyp ) or ( b = notyp )    {两个操作数中有一个nottype}

              then resulttype := notyp    {结果返回nottype}

              else if a = ints    {第一个是int}

                   then if b = ints    {第二个也是int}

                        then resulttype := ints    {返回int类型}

                        else begin

                               resulttype := reals;    {否则结果为real}

                               emit1(,)    {并对a进行类型转化}

                            end

                   else begin

                          resulttype := reals;    {第一个是real,则返回real}

                          if b = ints    {如果第二个是int}

                          then emit1(,)    {对b进行转化}

                       end

       end { resulttype } ;

     procedure expression( fsys: symset; var x: item );    {处理表达式的过程,返回类型和在表中的位置}

       var y : item;

          op : symbol;

       procedure simpleexpression( fsys: symset; var x: item );

         var y : item;

             op : symbol;

         procedure term( fsys: symset; var x: item );

           var y : item;

               op : symbol;

           procedure factor( fsys: symset; var x: item );{处理因子的子过程}

             var i,f : integer;

             procedure standfct( n: integer );    {处理标准函数的子过程，传入标准函数的编号n，执行不同的操作}

               var ts : typset;    {类型集合}

               begin  { standard function no. n }

                 if sy = lparent    {如果当前的符号是左括号}

                 then insymbol    {获取下一个sym}

                 else error();    {如果当前符号不是左括号,报9号错误提示左括号出错}

                 if n <     {如果标准函数的编号小于17}

                 then begin

                        expression( fsys+[rparent], x );    {递归调用处理表达式的过程来处理参数,x是获取的参数的信息}

                        case n of    {根据不同的函数编号来进行操作}

                        { abs, sqr } ,: begin    {如果是0,2号操作,完成求绝对值和平方}

                                            ts := [ints, reals];    {定义符号集合为整型和实型}

                                            tab[i].typ := x.typ;    {函数的返回值类型}

                                            if x.typ = reals    {如果参数类型是实数}

                                            then n := n +     {对应的函数标号+1}

                                      end;

                        { odd, chr } ,: ts := [ints];    {如果是4,5号操作,那么完成判奇和ascii码转化成字符的操作,要求传入的是脏呢挂车能}

                        { odr }        : ts := [ints,bools,chars];    {6号操作允许类型是整型,布尔型或者字符型}

                        { succ,pred } , : begin    {对于7,8号操作}

                                              ts := [ints, bools,chars];    {允许参数类型是整型,布尔型或者字符型}

                                              tab[i].typ := x.typ    {记录类型}

                                        end;

                        { round,trunc } ,,,,,,,:    {数学运算}

                        { sin,cos,... }     begin

                                              ts := [ints,reals];    {允许参数类型为整型,实型}

                                              if x.typ = ints    {如果为整型}

                                              then emit1(,)    {先将整型转成实型}

                                        end;

                      end; { case }

                      if x.typ in ts    {如果函数的类型符合要求的符号集}

                      then emit1(,n)    {调用8号指令,生成标准函数}

                      else if x.typ <> notyp    {如果x的类型未定义}

                           then error();    {报48号错误,类型错误}

                    end

                 else begin { n in [17,18] }    {如果编号是17或者18,即判断输入是否结束}

                        if sy <> ident    {传入的首先应当是标识符}

                        then error()    {不是标识符报错}

                        else if id <> 'input    '    {如果对应的id不是'input    '}

                             then error()    {报0号错误,未知id}

                             else insymbol;    {没错的话读取下一个sym}

                        emit1(,n);    {生成标准函数}

                      end;

                 x.typ := tab[i].typ;    {记录返回值类型}

                 if sy = rparent    {识别是否遇到右括号}

                 then insymbol    {获取下一个sym,标准函数处理过程结束}

                 else error()    {如果没有识别到右括号,报4号错误}

               end { standfct } ;

             begin { factor }    {因子分析程序开始}

               x.typ := notyp;    {初始化返回值类型}

               x.ref := ;        {初始化返回的位置指针}

               test( facbegsys, fsys, );    {检查当前的符号是否是合法的因子开始符号}

               while sy in facbegsys do    {当当前的符号是因子的开始符号时}

                 begin

                   if sy = ident    {如果识别到标识符}

                   then begin

                          i := loc(id);    {获取当前标识符在符号表中的位置保存到i}

                          insymbol;        {获取下一个sym}

                          with tab[i] do    {对当前符号对应的表项进行操作}

                            case obj of    {对于不同的obj属性执行不同的操作}

                              konstant: begin    {如果是常量类型}

                                          x.typ := typ;    {返回值的类型就设置为表中记录的typ}

                                          x.ref := ;    {索引值设置为0}

                                          if x.typ = reals    {如果是实数类型的常量}

                                          then emit1(,adr)    {将实数装入数据栈,注意实数常量的adr对应着其在rconst实常量表中的位置}

                                          else emit1(,adr)    {如果是整型直接存入栈顶即可}

                                      end;

                              vvariable:begin    {如果换成变量类型}

                                              x.typ := typ;    {获得需要返回类型}

                                              x.ref := ref;    {获得需要返回地址}

                                          if sy in [lbrack, lparent,period]    {如果标识符后面跟的是左方括号,左括号或者是句号,说明该变量存在子结构}

                                          then begin

                                                 if normal    {如果是实形参}

                                                 then f :=     {取地址}

                                                 else f := ;    {否则是变量形参,取值并放到栈顶}

                                                 emit2(f,lev,adr);    {生成对应的代码}

                                                 selector(fsys,x);    {处理子结构}

                                                 if x.typ in stantyps    {如果是标准类型}    {存疑}

                                                 then emit()    {将该值放到栈顶}

                                               end

                                          else begin    {如果变量没有层次结构}

                                                 if x.typ in stantyps    {如果是标准类型}

                                                 then if normal    {如果是值形参}

                                                      then f :=     {执行取值操作}

                                                      else f :=     {否则间接取值}

                                                 else if normal    {如果不是标准类型但是是值形参}

                                                      then f :=     {取地址操作}

                                                 else f := ;    {如果既不是标准类型又不是值形参,执行取值操作}

                                                 emit2(f,lev,adr)    {生成对应指令}

                                              end

                                        end;

                              typel,prozedure: error();    {如果是类型类型或者过程类型,报44号类型错误}

                              funktion: begin    {如果是函数符号}

                                          x.typ := typ;    {记录类型}

                                          if lev <>     {如果层次不为0,即不是标准函数}

                                          then call(fsys,i)    {调用call函数来处理函数调用}

                                          else standfct(adr)    {如果层次为零,调用标准函数}

                                        end

                            end { case,with }

                        end

                   else if sy in [ charcon,intcon,realcon ]    {如果符号的类型是字符类型,整数类型或者实数类型}

                        then begin

                               if sy = realcon    {对于实数类型}

                               then begin

                                      x.typ := reals;    {将返回的type设置为实型}

                                      enterreal(rnum);    {将该实数放入实数表,rnum存有实数的值}

                                      emit1(,c1)    {将实常量表中第c1个(也就是刚刚放进去的)元素放入栈顶}

                                    end

                               else begin

                                      if sy = charcon    {对于字符类型}

                                      then x.typ := chars    {记录返回的类型是字符型}

                                      else x.typ := ints;    {否则肯定是整形啦,要不进不来这个分支}

                                      emit1(,inum)    {装入字面变量,可以看出字符型装的是ascii码值}

                                    end;

                               x.ref := ;    {返回的ref设置为0}

                               insymbol    {获取下一个sym}

                             end

                    else if sy = lparent        {如果符号的类型是左括号}

                         then begin

                                insymbol;    {获取下一个sym}

                                expression(fsys + [rparent],x);    {调用处理表达式的递归子程序处理括号中的表达式}

                                if sy = rparent    {如果遇到了右括号}

                                then insymbol    {获取下一个sym}

                                else error()    {没有右括号报4号错误}

                              end

                    else if sy = notsy    {如果符号的类型未定义}

                        then begin

                               insymbol;    {获取下一个sym}

                               factor(fsys,x);    {递归调用因子的分析子程序}

                               if x.typ = bools    {如果返回的类型是布尔型}

                               then emit()        {生成逻辑非指令}

                               else if x.typ <> notyp    {如果因子的类型依旧未定义}

                                    then error()    {生成32指令,退出过程}

                            end;

                   test(fsys,facbegsys,)    {检查当前符号是否合法}

                 end { while }

             end { factor };

           begin { term   }    {开始处理项(term)}

             factor( fsys + [times,rdiv,idiv,imod,andsy],x);    {调用因子的分析程序开分析每一个因子项}

             while sy in [times,rdiv,idiv,imod,andsy] do    {如果因子后面跟符号'*''/''div''mod''and',说明后面还有因子,进入循环}

               begin

                 op := sy;    {运算符是sy所代表的类型}

                 insymbol;    {获取下一个sym}

                 factor(fsys+[times,rdiv,idiv,imod,andsy],y );    {继续调用因子分析程序来分析因子,获得第二个运算数存为y}

                 if op = times    {如果遇到了乘号}

                 then begin

                        x.typ := resulttype(x.typ, y.typ);    {求出计算之后结果的类型}

                        case x.typ of

                          notyp: ;    {未定义类型不干事儿}

                          ints : emit();    {整数生成整数乘指令}

                          reals: emit();    {实数生成实数乘指令}

                        end

                      end

                 else if op = rdiv    {除法运算}

                      then begin

                             if x.typ = ints

                             then begin

                                    emit1(,);    {整型转实型}

                                    x.typ := reals;

                                  end;

                             if y.typ = ints

                             then begin

                                    emit1(,);    {整型转实型}

                                    y.typ := reals;

                                  end;

                             if (x.typ = reals) and (y.typ = reals)

                             then emit()    {实型除法}

                             else begin

                                    if( x.typ <> notyp ) and (y.typ <> notyp)

                                    then error();

                                    x.typ := notyp

                                  end

                           end

                      else if op = andsy    {与运算}

                           then begin

                                  if( x.typ = bools )and(y.typ = bools)    {必须两个运算数都是布尔类型}

                                  then emit()    {生成逻辑与运算}

                                  else begin

                                         if( x.typ <> notyp ) and (y.typ <> notyp)    {类型不对报错,提示应该是布尔值}

                                         then error();

                                         x.typ := notyp

                                       end

                                end

                           else begin { op in [idiv,imod] }

                                  if (x.typ = ints) and (y.typ = ints)

                                  then if op = idiv    {如果是除法}

                                         then emit()    {生成除法运算的代码}

                                       else emit()    {否则生成取模运算的代码}

                                  else begin

                                         if ( x.typ <> notyp ) and (y.typ <> notyp)

                                         then error();    {类型出错报错}

                                         x.typ := notyp

                                       end

                                end

               end { while }

           end { term };

         begin { simpleexpression }    {开始处理简单表达式}

           if sy in [plus,minus]    {获得的是加减号}

           then begin

                  op := sy;    {记录运算符}

                  insymbol;

                  term( fsys+[plus,minus],x);    {处理项}

                  if x.typ > reals    {类型是 bools, chars, arrays, records}

                  then error()        {由于不是算数运算类型,报错}

                  else if op = minus    {如果是减号}

                       then emit()    {去相反数}

                end

           else term(fsys+[plus,minus,orsy],x);

           while sy in [plus,minus,orsy] do

             begin

               op := sy;

               insymbol;

               term(fsys+[plus,minus,orsy],y);

               if op = orsy    {如果是or关键字}

               then begin

                      if ( x.typ = bools )and(y.typ = bools)    {操作数限定为bool}

                      then emit()    {生成OR指令}

                      else begin

                             if( x.typ <> notyp) and (y.typ <> notyp)    {类型不对报错}

                             then error();

                             x.typ := notyp

                           end

                    end

               else begin

                      x.typ := resulttype(x.typ,y.typ);

                      case x.typ of

                        notyp: ;

                        ints: if op = plus    {整数加减}

                              then emit()

                              else emit();

                        reals:if op = plus    {实数加减}

                              then emit()

                              else emit()

                      end { case }

                    end

             end { while }

           end { simpleexpression };

       begin { expression  }

         simpleexpression(fsys+[eql,neq,lss,leq,gtr,geq],x);

         if sy in [ eql,neq,lss,leq,gtr,geq]    {判别多种数值比较符号}

         then begin

                op := sy;

                insymbol;

                simpleexpression(fsys,y);    {获得第二个简单表达式的值}

                if(x.typ in [notyp,ints,bools,chars]) and (x.typ = y.typ)    {整型,布尔和字符都可以借用整型的运算}{notyp为什么出现?}

                then case op of    {根据不同的符号来生成不同的PCODE}

                       eql: emit();

                       neq: emit();

                       lss: emit();

                       leq: emit();

                       gtr: emit();

                       geq: emit();

                     end

                else begin

                       if x.typ = ints

                       then begin

                              x.typ := reals;

                              emit1(,)

                            end

                       else if y.typ = ints

                            then begin

                                   y.typ := reals;

                                   emit1(,)

                                 end;

                       if ( x.typ = reals)and(y.typ=reals)    {对于实数同样生成不同的PCODE}

                       then case op of

                              eql: emit();

                              neq: emit();

                              lss: emit();

                              leq: emit();

                              gtr: emit();

                              geq: emit();

                            end

                       else error()

                     end;

                x.typ := bools

              end

       end { expression };

     procedure assignment( lv, ad: integer );    {处理赋值语句的过程}

       var x,y: item;

           f  : integer;

       begin   { tab[i].obj in [variable,prozedure] }    {当且仅当当前符号表的目标类型为变量或者过程型时}

         x.typ := tab[i].typ;

         x.ref := tab[i].ref;

         if tab[i].normal

         then f :=

         else f := ;

         emit2(f,lv,ad);

         if sy in [lbrack,lparent,period]

         then selector([becomes,eql]+fsys,x);    {处理下标}

         if sy = becomes    {赋值符号}

         then insymbol

         else begin

                error();

                if sy = eql    {等号容错}

                then insymbol

              end;

         expression(fsys,y);    {获得赋值符号右边的值}

         if x.typ = y.typ

         then if x.typ in stantyps

              then emit()    {完成赋值操作}

              else if x.ref <> y.ref

                   then error()

              else if x.typ = arrays    {数组类型需要拷贝块}

                   then emit1(,atab[x.ref].size)    {拷贝atab中的项}

                   else emit1(,btab[x.ref].vsize)    {拷贝btab中的记录项}

         else if(x.typ = reals )and (y.typ = ints)

         then begin

                emit1(,);

                emit()

              end

         else if ( x.typ <> notyp ) and ( y.typ <> notyp )

              then error()

       end { assignment };

     procedure compoundstatement;

       begin

         insymbol;

         statement([semicolon,endsy]+fsys);

         while sy in [semicolon]+statbegsys do

           begin

             if sy = semicolon

             then insymbol

             else error();

             statement([semicolon,endsy]+fsys)

           end;

         if sy = endsy

         then insymbol

         else error()

       end { compoundstatement };

     procedure ifstatement;

       var x : item;

           lc1,lc2: integer;

       begin

         insymbol;

         expression( fsys+[thensy,dosy],x);

         if not ( x.typ in [bools,notyp])

         then error();

         lc1 := lc;

         emit();  { jmpc }

         if sy = thensy

         then insymbol

         else begin

                error();

                if sy = dosy

                then insymbol

              end;

         statement( fsys+[elsesy]);

         if sy = elsesy

         then begin

                insymbol;

                lc2 := lc;

                emit();

                code[lc1].y := lc;

                statement(fsys);

                code[lc2].y := lc

              end

         else code[lc1].y := lc

       end { ifstatement };

     procedure casestatement;{case语句的处理过程}

       var x : item;

       i,j,k,lc1 : integer;    {定义一系列临时变量}

       casetab : array[..csmax]of    {csmax表示case个数的最大限度}

                      packed record

                        val,lc : index    {index表示}

                      end;

           exittab : array[..csmax] of integer;

       procedure caselabel;    {处理case语句中的标号,将各标号对应的目标代码入口地址填入casetab表中,并检查标号有无重复定义}

         var lab : conrec;

          k : integer;

         begin

           constant( fsys+[comma,colon],lab );    {因为标签都是常量,这里调用处理常量的过程来获得常量的值,存于lab}

           if lab.tp <> x.typ    {如果获得的标签类型和变量的类型不同}

           then error()    {报label类型错误}

           else if i = csmax    {如果可以声明的case达到了最大限度}

                then fatal()    {报6号严重错误,程序终止}

                else begin

                       i := i+;    {移动case表的指针,声明新的case}

                        k := ;    {用来检查标号是否重复定义的变量}

                       casetab[i].val := lab.i;    {保存新case的值}

                       casetab[i].lc := lc;        {记录新case生成代码的位置}

                       repeat

                         k := k+

                       until casetab[k].val = lab.i;    {扫一遍已经声明的label,看有没有重复声明}

                       if k < i    {重复声明}

                       then error(); { multiple definition }    {报1号错误}

                     end

         end { caselabel };

       procedure onecase;    {用来处理case语句的一个分支}

         begin

           if sy in constbegsys    {确定当前符号是常量的类型集合}

           then begin

                  caselabel;    {获取一个标签}

                  while sy = comma do    {如果有逗号说明是一个case对应多个标签的情况}

                    begin

                      insymbol;    {继续获取标签的label}

                      caselabel    {继续处理}

                    end;

                  if sy = colon    {读到冒号,说明label声明结束了}

                  then insymbol    {获取下一个sym}

                  else error();    {没读到冒号,报5号错误}

                  statement([semicolon,endsy]+fsys);    {递归调用statement来处理冒号之后需要执行的程序}

                  j := j+;    {用来记录当前case对应exittab的位置}

                  exittab[j] := lc;    {记录当前case分支结束的代码位置,即下面将要生成的跳转指令的位置}

                  emit()    {生成一条跳转指令来结束这一case分支}

                end

           end { onecase };

       begin  { casestatement  }

         insymbol;    {获取下一个sym}

         i := ;

         j := ;

         expression( fsys + [ofsy,comma,colon],x );    {递归调用处理表达式的方式先获得当前表达式的属性,即case后面变量的类型}

         if not( x.typ in [ints,bools,chars,notyp ])    {如果当前的表达式不是整数,布尔型,字符型或未定义类型}

         then error();    {报23号错误,case类型错误}

         lc1 := lc;    {记录当前PCODE代码的位置指针}

         emit(); {jmpx}    {生成SWT代码,查找情况表,注意这里暂时没有给定跳转的地址}

         if sy = ofsy    {如果接着读到了of关键字}

         then insymbol    {获取下一个sym}

         else error();    {丢失of关键字的情况报8号错}

         onecase;    {调用onecase方法处理}

         while sy = semicolon do    {遇到了分号,说明还有更多的case分支}

           begin

             insymbol;    {获取下一个sym}

             onecase        {处理下一个sym}

           end;

         code[lc1].y := lc;    {此时确定了情况表的开始地址,回填给之前声明的SWT代码,确保其能够成功跳转}

         for k :=  to i do    {便利所有case分支}

           begin    {建立情况表}

             emit1( ,casetab[k].val);    {建立查找的值}

             emit1( ,casetab[k].lc);    {给出对应的跳转地址}

           end;

         emit1(,);    {生成JMP代码,说明情况表结束}

         for k :=  to j do    {给定每个case分支退出之后的跳转地址}

           code[exittab[k]].y := lc;    {现在的lc指向情况表结束之后的位置,将各分支的结束跳转地址指向这里}

         if sy = endsy    {如果遇到了end关键字}

         then insymbol    {读取下一个sym,case处理完毕}

         else error()    {否则报57号错误}

       end { casestatement };

     procedure repeatstatement;{处理repeat语句的处理过程}

       var x : item;        {用来获取返回值}

           lc1: integer;    {用来记录repeat的开始位置}

       begin

         lc1 := lc;    {保存repeat当开始时的代码地址}

         insymbol;    {获取下一个sym}

         statement( [semicolon,untilsy]+fsys);    {调用statement递归子程序来处理循环体中的语句}

         while sy in [semicolon]+statbegsys do    {如果遇到了分号或者statement的开始符号,则说明循环体中还有语句没有处理完}

           begin

             if sy = semicolon    {如果确实是分号}

             then insymbol    {获取下一个sym}

             else error();    {报14号错,提示分号错误}

             statement([semicolon,untilsy]+fsys)    {处理循环体中的下一条语句}

           end;

         if sy = untilsy    {如果遇到了until关键字}

         then begin

                insymbol;    {获取下一个sym,即循环条件}

                expression(fsys,x);    {处理该表达式,获得其类型}

                if not(x.typ in [bools,notyp] )    {如果不是未定义类型或者布尔型的表达式}

                then error();    {报17号错误,提示需要布尔型表达式}

                emit1(,lc1);    {生成一条条件跳转指令,如果表达式的值是假的,则跳转回repeat开始的位置重新执行一遍}

              end

         else error()    {没找到until,报53号错}

       end { repeatstatement };

     procedure whilestatement;    {处理while循环的过程}

       var x : item;

           lc1,lc2 : integer;

       begin

         insymbol;

         lc1 := lc;

         expression( fsys+[dosy],x);

         if not( x.typ in [bools, notyp] )

         then error();

         lc2 := lc;

         emit();

         if sy = dosy

         then insymbol

         else error();

         statement(fsys);

         emit1(,lc1);

         code[lc2].y := lc

      end { whilestatement };

     procedure forstatement;    {处理for循环语句}

       var   cvt : types;

             x :  item;

             i,f,lc1,lc2 : integer;

      begin

         insymbol;    {获取下一个sym}

         if sy = ident    {如果获取到的是标识符}

         then begin

                i := loc(id);    {找到这个标识符在符号表中登陆的位置,实际上是计数变量}

                insymbol;    {获取下一个sym}

                if i =     {如果没有找到这个标识符}

                then cvt := ints    {计数变量类型默认为整形}

                else if tab[i].obj = vvariable    {如果对应的这个标识符对应符号的大类是变量类型}

                     then begin

                            cvt := tab[i].typ;    {计数变量类型就设置为这个变量的类型}

                            if not tab[i].normal    {如果是变量形参,即变量存储的是值而非地址}

                            then error()        {报37号错}

                            else emit2(,tab[i].lev, tab[i].adr );    {如果不是变量类型, 获取该符号的地址}

                            if not ( cvt in [notyp, ints, bools, chars])    {如果获取到计数变量的类型不是未定义,整型,布尔型,字符型}

                                    then error()    {报18号错误}

                          end

                     else begin    {如果符号的类型也不是变量}

                            error();    {报37号错误}

                            cvt := ints    {将计数变量类型设置为整型}    {仅仅是给个值,还是有什么意义?}

                          end

              end

         else skip([becomes,tosy,downtosy,dosy]+fsys,);    {跳过无用符号}

         if sy = becomes    {如果识别到了赋值符号}

         then begin

                insymbol;    {获取下一个sym}

                expression( [tosy, downtosy,dosy]+fsys,x);    {递归调用处理表达式的方式来获得表达式的值和类型}

                if x.typ <> cvt    {如果获取到的表达式类型和计数变量的符号类型不相同}

                then error();    {报19号错误}

              end

         else skip([tosy, downtosy,dosy]+fsys,);    {未识别到赋值符号,则继续执行}

         f := ;    {生成指令的编号,暂存14号}

         if sy in [tosy,downtosy]    {如果当前符号是to关键字或者downto关键字,其中to是每次循环变量自加一,downto是每次循环变量自减一}

         then begin

                if sy = downtosy    {如果是down}

                then f := ;    {}

                insymbol;        {获取下一个sym}

                expression([dosy]+fsys,x);    {调用处理表达式的递归子程序处理括号中的表达式}

                if x.typ <> cvt    {如果表达式的类型和左边的计数变量不同}

                then error()    {报19号错误}

              end

         else skip([dosy]+fsys,);    {跳过直到do之前的代码段}

         lc1 := lc;    {记录下句F1U指令的位置}

         emit(f);    {生成F1U或F1D指令,进行循环体的入口测试}

         if sy = dosy    {如果当前符号是do关键字}

         then insymbol    {获取下一个sym}

         else error();    {没找到do,报54号错误}

         lc2 := lc;    {获取循环体开始代码的位置}

         statement(fsys);    {递归调用statement来处理循环体语句}

         emit1(f+,lc2);        {结束时生成F2U或F2D指令}

         code[lc1].y := lc    {将之前产生的F1U的跳转地址回传回去}

      end { forstatement };

     procedure standproc( n: integer );

       var i,f : integer;

       x,y : item;

       begin

         case n of

           , : begin { read }

                   if not iflag

                   then begin

                          error();

                          iflag := true

                        end;

                   if sy = lparent

                   then begin

                          repeat

                            insymbol;

                            if sy <> ident

                            then error()

                            else begin

                                   i := loc(id);

                                   insymbol;

                                   if i <>

                                   then if tab[i].obj <> vvariable

                                        then error()

                                        else begin

                                               x.typ := tab[i].typ;

                                               x.ref := tab[i].ref;

                                               if tab[i].normal

                                               then f :=

                                               else f := ;

                                               emit2(f,tab[i].lev,tab[i].adr);

                                               if sy in [lbrack,lparent,period]

                                               then selector( fsys+[comma,rparent],x);

                                               if x.typ in [ints,reals,chars,notyp]

                                               then emit1(,ord(x.typ))

                                               else error()

                                            end

                                end;

                            test([comma,rparent],fsys,);

                          until sy <> comma;

                          if sy = rparent

                          then insymbol

                          else error()

                        end;

                   if n =

                   then emit()

                 end;

           , : begin { write }

                   if sy = lparent

                   then begin

                          repeat

                            insymbol;

                            if sy = stringcon

                            then begin

                                   emit1(,sleng);

                                   emit1(,inum);

                                   insymbol

                                 end

                            else begin

                                   expression(fsys+[comma,colon,rparent],x);

                                   if not( x.typ in stantyps )

                                   then error();

                                   if sy = colon

                                   then begin

                                          insymbol;

                                          expression( fsys+[comma,colon,rparent],y);

                                          if y.typ <> ints

                                          then error();

                                          if sy = colon

                                          then begin

                                                 if x.typ <> reals

                                                 then error();

                                                 insymbol;

                                                 expression(fsys+[comma,rparent],y);

                                                 if y.typ <> ints

                                                 then error();

                                                 emit()

                                               end

                                          else emit1(,ord(x.typ))

                                        end

                              else emit1(,ord(x.typ))

                            end

                          until sy <> comma;

                          if sy = rparent

                          then insymbol

                          else error()

                        end;

                   if n =

                   then emit()

                 end; { write }

         end { case };

       end { standproc } ;

     begin { statement }

       if sy in statbegsys+[ident]

       then case sy of

              ident : begin

                        i := loc(id);

                        insymbol;

                        if i <>

                        then case tab[i].obj of

                               konstant,typel : error();

                               vvariable:       assignment( tab[i].lev,tab[i].adr);

                               prozedure:       if tab[i].lev <>

                                                then call(fsys,i)

                                                else standproc(tab[i].adr);

                               funktion:        if tab[i].ref = display[level]

                                                then assignment(tab[i].lev+,)

                                                else error()

                             end { case }

                      end;

              beginsy : compoundstatement;

              ifsy    : ifstatement;

              casesy  : casestatement;

              whilesy : whilestatement;

              repeatsy: repeatstatement;

              forsy   : forstatement;

            end;  { case }

       test( fsys, [],);

     end { statement };

   begin  { block }

     dx := ;    {dx是变量存储分配的索引,预设为5是为了给内务信息区留出空间}

     prt := t;    {获取当前符号表的位置}

     if level > lmax    {如果当前子程序的层次已经超过了允许的最大层次}

     then fatal();    {报5号错误}

     test([lparent,colon,semicolon],fsys,);    {检查当前的符号是否是左括号,冒号,分号中的一个,不是报14号错误}

     enterblock;

     prb := b;

     display[level] := b;

     tab[prt].typ := notyp;

     tab[prt].ref := prb;

     if ( sy = lparent ) and ( level >  )

     then parameterlist;

     btab[prb].lastpar := t;

     btab[prb].psize := dx;

     if isfun

     then if sy = colon

          then begin

                 insymbol; { function type }

                 if sy = ident

                 then begin

                        x := loc(id);

                        insymbol;

                        if x <>

                        then if tab[x].typ in stantyps

                             then tab[prt].typ := tab[x].typ

                             else error()

                      end

                 else skip( [semicolon]+fsys, )

               end

          else error();

     if sy = semicolon

     then insymbol

     else error();

     repeat

       if sy = constsy

       then constdec;

       if sy = typesy

       then typedeclaration;

       if sy = varsy

       then variabledeclaration;

       btab[prb].vsize := dx;

       while sy in [procsy,funcsy] do

         procdeclaration;

       test([beginsy],blockbegsys+statbegsys,)

     until sy in statbegsys;

     tab[prt].adr := lc;

     insymbol;

     statement([semicolon,endsy]+fsys);

     while sy in [semicolon]+statbegsys do

       begin

         if sy = semicolon

         then insymbol

         else error();

         statement([semicolon,endsy]+fsys);

       end;

     if sy = endsy

     then insymbol

     else error();

     test( fsys+[period],[], )

   end { block };

 procedure interpret;

   var ir : order ;         { instruction buffer }    {当前的指令}

       pc : integer;        { program counter }    {类似于指令寄存器}

       t  : integer;        { top stack index }    {栈顶指针}

       b  : integer;        { base index }    {基址地址}

       h1,h2,h3: integer;    {临时变量}

       lncnt,ocnt,blkcnt,chrcnt: integer;     { counters }

       ps : ( run,fin,caschk,divchk,inxchk,stkchk,linchk,lngchk,redchk );    {各种错误信息标志}

            fld: array [..] of integer;  { default field widths }

            display : array[..lmax] of integer;

            s  : array[..stacksize] of   { blockmark:     }

             record

               case cn : types of        { s[b+0] = fct result }

                 ints : (i: integer );   { s[b+1] = return adr }

                 reals :(r: real );      { s[b+2] = static link }

                 bools :(b: boolean );   { s[b+3] = dynamic link }

                 chars :(c: char )       { s[b+4] = table index }

             end;

   procedure dump;

     var p,h3 : integer;

     begin

       h3 := tab[h2].lev;

       writeln(psout);

       writeln(psout);

       writeln(psout,'       calling ', tab[h2].name );

       writeln(psout,'         level ',h3:);

       writeln(psout,' start of code ',pc:);

       writeln(psout);

       writeln(psout);

       writeln(psout,' contents of display ');

       writeln(psout);

       for p := h3 downto  do

         writeln(psout,p:,display[p]:);

       writeln(psout);

       writeln(psout);

       writeln(psout,' top of stack  ',t:,' frame base ':,b:);

       writeln(psout);

       writeln(psout);

       writeln(psout,' stack contents ':);

       writeln(psout);

       for p := t downto  do

         writeln( psout, p:, s[p].i:);

       writeln(psout,'< = = = >':)

     end; {dump }

     {以下为不同PCODE所对应的操作}

   procedure inter0;

     begin

       case ir.f of

          : begin { load addrss }    {取地址操作,LDA}

               t := t + ;    {栈顶指针上移}

               if t > stacksize    {如果超过了栈的大小上限}

               then ps := stkchk    {将ps设置为stkchk,以记录错误类型}

               else s[t].i := display[ir.x]+ir.y    {完成取值, 实际地址 = level起始地址+位移地址,放到栈顶}

             end;

          : begin  { load value }    {取值操作,LOD}

               t := t + ;

               if t > stacksize    {检查栈是否溢出,溢出则报错}

               then ps := stkchk

               else s[t] := s[display[ir.x]+ir.y]    {由于传入的是地址,完成取值后将值放到栈顶}

             end;

          : begin  { load indirect }    {间接取值,LDI}

               t := t + ;

               if t > stacksize

               then ps := stkchk

               else s[t] := s[s[display[ir.x]+ir.y].i]

             end;

          : begin  { update display }    {更新display,DIS}

               h1 := ir.y;

               h2 := ir.x;

               h3 := b;

               repeat

                 display[h1] := h3;

                 h1 := h1-;    {level-1}

                 h3 := s[h3+].i

               until h1 = h2

             end;

          : case ir.y of    {标准函数,ir.y是函数的编号,FCT}

                : s[t].i := abs(s[t].i);    {整数x求绝对值}

                : s[t].r := abs(s[t].r);    {实数x求绝对值}

                : s[t].i := sqr(s[t].i);    {整数x求平方}

                : s[t].r := sqr(s[t].r);    {实数x求平方}

                : s[t].b := odd(s[t].i);    {整数x判奇偶性,计数返回1}

                : s[t].c := chr(s[t].i);    {ascii码x转化为字符char}

                : s[t].i := ord(s[t].c);    {字符x转化为ascii码}

                : s[t].c := succ(s[t].c);    {求字符x的后继字符,比如'a'的后继是'b'}

                : s[t].c := pred(s[t].c);    {求字符x的前导字符}

                : s[t].i := round(s[t].r);    {求x的四舍五入}

                : s[t].i := trunc(s[t].r);    {求实数x的整数部分}

                : s[t].r := sin(s[t].r);    {求正弦sin(x),注意x为实数弧度}

                : s[t].r := cos(s[t].r);    {求余弦sin(x),注意x为实数弧度}

                : s[t].r := exp(s[t].r);    {求e^x,x为实数}

                : s[t].r := ln(s[t].r);    {求自然对数ln(x),x为实数}

                : s[t].r := sqrt(s[t].r);    {实数x开方}

                : s[t].r := arcTan(s[t].r);    {反三角函数arctan(x)}

                : begin

                      t := t+;    {}

                      if t > stacksize

                      then ps := stkchk

                      else s[t].b := eof(prd)    {判断输入有没有读完}

                    end;

                : begin

                      t := t+;

                      if t > stacksize

                      then ps := stkchk

                      else s[t].b := eoln(prd)    {判断该行有没有读完}

                    end;

             end;

          : s[t].i := s[t].i + ir.y; { offset }    {将栈顶元素加上y,INT}

       end { case ir.y }

     end; { inter0 }

 procedure inter1;

     var h3, h4: integer;

 begin

       case ir.f of

          : pc := ir.y ; { jump }    {调到第y条指令代码,JMP}

          : begin  { conditional jump }    {条件跳转语句,JPC}

                if not s[t].b    {如果栈顶值为假}

                then pc := ir.y;    {跳转到y指令}

                t := t -     {退栈}

             end;

          : begin { switch }    {转移到y的地址,查找情况表,情况表由一系列f为13的指令构成}

                h1 := s[t].i;    {记录栈顶值}

                t := t-;    {退栈}

                h2 := ir.y;    {记录需要跳转到的地址}

                h3 := ;

                repeat

                  if code[h2].f <>     {如果操作码不是13,证明跳转到的不是情况表}

                  then begin

                         h3 := ;

                         ps := caschk

                       end

                  else if code[h2].y = h1

                       then begin

                              h3 := ;

                              pc := code[h2+].y

                            end

                       else h2 := h2 +

                until h3 <>

              end;

          : begin { for1up }    {增量步长for循环的初始判断,F1U}

                h1 := s[t-].i;    {for循环之前需要储存计数变量的地址,初值和终值,这里h1获取的是初值}

                if h1 <= s[t].i    {如果初值小于等于终值}

                then s[s[t-].i].i := h1    {开始循环,将技术变量的值赋为初值}

                else begin    {否则循环完毕}

                       t := t - ;    {退栈3格,退去计数变量的地址,初值和终值所占用的空间}

                       pc := ir.y    {跳出循环,注意这里的y是由后方语句回传得到的}

                     end

              end;

          : begin { for2up }    {增量步长的结束判断,F2U}

                h2 := s[t-].i;    {获得计数变量的地址}

                h1 := s[h2].i+;    {h1为计数变量的值自增一}

                if h1 <= s[t].i    {判断是否还满足循环条件}

                then begin

                       s[h2].i := h1;    {如果满足,将h1赋给计数变量}

                       pc := ir.y    {跳转到循环的开始位置}

                     end

                else t := t-;    {不满足的情况不做跳转(执行下一条),退栈3格}

              end;

          : begin  { for1down }    {减量步长for循环的初始判断,F1U}

                h1 := s[t-].i;

                if h1 >= s[t].i

                then s[s[t-].i].i := h1

                else begin

                       pc := ir.y;

                       t := t -

                     end

              end;

          : begin  { for2down }    {减量步长的结束判断,F2U}

                h2 := s[t-].i;

                h1 := s[h2].i-;

                if h1 >= s[t].i

                then begin

                       s[h2].i := h1;

                       pc := ir.y

                     end

                else t := t-;

              end;

          : begin  { mark stack }    {标记栈}

                h1 := btab[tab[ir.y].ref].vsize;    {获得当前过程所需要的栈空间的大小}

                if t+h1 > stacksize    {如果超过上限报错}

                then ps := stkchk

                else begin

                       t := t+;    {预留内务信息区}

                       s[t-].i := h1-;    {次栈顶存放vsize-1}

                       s[t].i := ir.y    {栈顶存放被调用过程在tab表中的位置}

                     end

              end;

          : begin  { call }    {过程或函数调用过程}

                h1 := t-ir.y;  { h1 points to base }    {h1指向基址}

                h2 := s[h1+].i;  { h2 points to tab }    {h2指向过程名在tab表中的位置}

                h3 := tab[h2].lev;    {h3记录当前过程或函数的层次}

                display[h3+] := h1;    {新建一个层次,并将该层次基址指向当前层次基址}

                h4 := s[h1+].i+h1;    {DL的值}

                s[h1+].i := pc;

                s[h1+].i := display[h3];

                s[h1+].i := b;

                for h3 := t+ to h4 do

                  s[h3].i := ;

                b := h1;

                t := h4;

                pc := tab[h2].adr;

                if stackdump

                then dump

              end;

       end { case }

     end; { inter1 }

   procedure inter2;

     begin

       case ir.f of

          : begin   { index1 }

                h1 := ir.y;  { h1 points to atab }

                h2 := atab[h1].low;

                h3 := s[t].i;

                if h3 < h2

                then ps := inxchk

                else if h3 > atab[h1].high

                     then ps := inxchk

                     else begin

                            t := t-;

                            s[t].i := s[t].i+(h3-h2)

                          end

              end;

          : begin  { index }

                h1 := ir.y ; { h1 points to atab }

                h2 := atab[h1].low;

                h3 := s[t].i;

                if h3 < h2

                then ps := inxchk

                else if h3 > atab[h1].high

                     then ps := inxchk

                     else begin

                            t := t-;

                            s[t].i := s[t].i + (h3-h2)*atab[h1].elsize

                          end

              end;

          : begin  { load block }    {装入块,LDB}

                h1 := s[t].i;    {获取栈顶值}

                t := t-;

                h2 := ir.y+t;    {获取需要分配到的空间位置}

                if h2 > stacksize    {栈空间不足,报错}

                then ps := stkchk

                else while t < h2 do    {将h1指向的块的值装入栈顶}

                       begin

                         t := t+;

                         s[t] := s[h1];

                         h1 := h1+

                       end

              end;

          : begin  { copy block }

                h1 := s[t-].i;

                h2 := s[t].i;

                h3 := h1+ir.y;

                while h1 < h3 do

                  begin

                    s[h1] := s[h2];

                    h1 := h1+;

                    h2 := h2+

                  end;

                t := t-

              end;

          : begin  { literal }        {装入字面变量,LDC}

                t := t+;

                if t > stacksize

                then ps := stkchk

                else s[t].i := ir.y    {对于整型变量y直接装入栈顶}

              end;

          : begin  { load real }    {读取实数,LDR}

                t := t+;

                if t > stacksize

                then ps := stkchk

                else s[t].r := rconst[ir.y]    {将实常量表中第i个元素放到数据栈的栈顶}

              end;

          : begin  { float }    {整型转实型,FLT}

                h1 := t-ir.y;    {获得符号的地址}

                s[h1].r := s[h1].i    {令实型等于整数部分}

              end;

          : begin  { read }

                if eof(prd)

                then ps := redchk

                else case ir.y of

                        : read(prd, s[s[t].i].i);

                        : read(prd, s[s[t].i].r);

                        : read(prd, s[s[t].i].c);

                     end;

                t := t-

              end;

          : begin   { write string }

                h1 := s[t].i;

                h2 := ir.y;

                t := t-;

                chrcnt := chrcnt+h1;

                if chrcnt > lineleng

                then ps := lngchk;

                repeat

                  write(prr,stab[h2]);

                  h1 := h1-;

                  h2 := h2+

                until h1 =

              end;

          : begin  { write1 }

                chrcnt := chrcnt + fld[ir.y];

                if chrcnt > lineleng

                then ps := lngchk

                else case ir.y of

                        : write(prr,s[t].i:fld[]);

                        : write(prr,s[t].r:fld[]);

                        : if s[t].b

                           then write('true')

                           else write('false');

                        : write(prr,chr(s[t].i));

                     end;

                t := t-

              end;

       end { case }

     end; { inter2 }

   procedure inter3;

     begin

       case ir.f of

          : begin { write2 }

                chrcnt := chrcnt+s[t].i;

                if chrcnt > lineleng

                then ps := lngchk

                else case ir.y of

                        : write(prr,s[t-].i:s[t].i);

                        : write(prr,s[t-].r:s[t].i);

                        : if s[t-].b

                           then write('true')

                           else write('false');

                     end;

                t := t-

              end;

          : ps := fin;

          : begin  { exit procedure }    {退出过程,EXP}

                t := b-;    {退栈}

                pc := s[b+].i;    {PC指向RA}

                b := s[b+].i    {获得返回后的base基址,s[b+3]指向DL}

              end;

          : begin  { exit function }    {退出函数,EXF}

                t := b;    {退栈,注意要保留函数名}

                pc := s[b+].i;    {PC指向RA}

                b := s[b+].i    {获得返回后的base基址,s[b+3]指向DL}

              end;

          : s[t] := s[s[t].i];

          : s[t].b := not s[t].b;    {逻辑非运算,将栈顶布尔值取反,NOT}

          : s[t].i := -s[t].i;        {取整数的相反数操作,MUS}

          : begin

                chrcnt := chrcnt + s[t-].i;

                if chrcnt > lineleng

                then ps := lngchk

                else write(prr,s[t-].r:s[t-].i:s[t].i);

                t := t-

              end;

          : begin  { store }    {将栈顶内容存入以次栈顶为地址的单元,STO}

                s[s[t-].i] := s[t];

                t := t-

              end;

          : begin    {实数相等,EQR}

                t := t-;

                s[t].b := s[t].r=s[t+].r

              end;

       end { case }

     end; { inter3 }

   procedure inter4;

     begin

       case ir.f of

          : begin    {实数不等,NER}

                t := t-;

                s[t].b := s[t].r <> s[t+].r

              end;

          : begin    {实数小于,LSR}

                t := t-;

                s[t].b := s[t].r < s[t+].r

              end;

          : begin    {实数小于等于,LER}

                t := t-;

                s[t].b := s[t].r <= s[t+].r

              end;

          : begin    {实数大于,GTR}

                t := t-;

                s[t].b := s[t].r > s[t+].r

              end;

          : begin    {实数大于等于,GER}

                t := t-;

                s[t].b := s[t].r >= s[t+].r

              end;

          : begin    {整数相等,EQL}

                t := t-;

                s[t].b := s[t].i = s[t+].i

              end;

          : begin    {整型不等,NEQ}

                t := t-;

                s[t].b := s[t].i <> s[t+].i

              end;

          : begin    {整型小于,LSS}

                t := t-;

                s[t].b := s[t].i < s[t+].i

              end;

          : begin    {整型小于等于,LEQ}

                t := t-;

                s[t].b := s[t].i <= s[t+].i

              end;

          : begin    {整型大于,GRT}

                t := t-;

                s[t].b := s[t].i > s[t+].i

              end;

       end { case }

     end; { inter4 }

   procedure inter5;

     begin

       case ir.f of

          : begin    {整型大于等于,GEQ}

                t := t-;

                s[t].b := s[t].i >= s[t+].i

              end;

          : begin    {OR指令,ORR}

                t := t-;

                s[t].b := s[t].b or s[t+].b

              end;

          : begin    {整数加,ADD}

                t := t-;

                s[t].i := s[t].i+s[t+].i

              end;

          : begin    {整数减,SUB}

                t := t-;

                s[t].i := s[t].i-s[t+].i

              end;

          : begin    {实数加,ADR}

                t := t-;

                s[t].r := s[t].r+s[t+].r;

              end;

          : begin    {实数减,SUR}

                t := t-;

                s[t].r := s[t].r-s[t+].r;

              end;

          : begin    {与运算,AND}

                t := t-;

                s[t].b := s[t].b and s[t+].b

              end;

          : begin    {整数乘,MUL}

                t := t-;

                s[t].i := s[t].i*s[t+].i

              end;

          : begin    {整数除法,DIV}

                t := t-;

                if s[t+].i =

                then ps := divchk

                else s[t].i := s[t].i div s[t+].i

              end;

          : begin    {取模运算,MOD}

                t := t-;

                if s[t+].i =

                then ps := divchk

                else s[t].i := s[t].i mod s[t+].i

              end;

       end { case }

     end; { inter5 }

   procedure inter6;

     begin

       case ir.f of

          : begin    {实数乘}

                t := t-;

                s[t].r := s[t].r*s[t+].r;

              end;

          : begin    {实数除}

                t := t-;

                s[t].r := s[t].r/s[t+].r;

              end;

          : if eof(prd)

              then ps := redchk

              else readln;

          : begin

                writeln(prr);

                lncnt := lncnt+;

                chrcnt := ;

                if lncnt > linelimit

                then ps := linchk

              end

       end { case };

     end; { inter6 }

   begin { interpret }

     s[].i := ;

     s[].i := ;

     s[].i := -;

     s[].i := btab[].last;

     display[] := ;

     display[] := ;

     t := btab[].vsize-;

     b := ;

     pc := tab[s[].i].adr;

     lncnt := ;

     ocnt := ;

     chrcnt := ;

     ps := run;

     fld[] := ;

     fld[] := ;

     fld[] := ;

     fld[] := ;

     repeat

       ir := code[pc];

       pc := pc+;

       ocnt := ocnt+;

       case ir.f div  of

          : inter0;

          : inter1;

          : inter2;

          : inter3;

          : inter4;

          : inter5;

          : inter6;

       end; { case }

     until ps <> run;

     if ps <> fin

     then begin

            writeln(prr);

            write(prr, ' halt at', pc :, ' because of ');

            case ps of    {根据不同的错误信息来进行报错}

              caschk  : writeln(prr,'undefined case');

              divchk  : writeln(prr,'division by 0');

              inxchk  : writeln(prr,'invalid index');

              stkchk  : writeln(prr,'storage overflow');

              linchk  : writeln(prr,'too much output');

              lngchk  : writeln(prr,'line too long');

              redchk  : writeln(prr,'reading past end or file');

            end;

            h1 := b;

            blkcnt := ;    { post mortem dump }

            repeat

              writeln( prr );

              blkcnt := blkcnt-;

              if blkcnt =

              then h1 := ;

              h2 := s[h1+].i;

              if h1 <>

              then writeln( prr, '',tab[h2].name, 'called at', s[h1+].i:);

              h2 := btab[tab[h2].ref].last;

              while h2 <>  do

                with tab[h2] do

                  begin

                    if obj = vvariable

                    then if typ in stantyps

                         then begin

                                write(prr,'',name,'=');

                                if normal

                                then h3 := h1+adr

                                else h3 := s[h1+adr].i;

                                case typ of

                                  ints : writeln(prr,s[h3].i);

                                  reals: writeln(prr,s[h3].r);

                                  bools: if s[h3].b

                                         then writeln(prr,'true')

                                         else writeln(prr,'false');

                                  chars: writeln(prr,chr(s[h3].i mod  ))

                                end

                              end;

                    h2 := link

                  end;

              h1 := s[h1+].i

            until h1 <

          end;

     writeln(prr);

     writeln(prr,ocnt,' steps');

   end; { interpret }

 procedure setup;    {程序运行前的准备过程}

   begin

     key[] := 'and       ';    {定义一系列保留字}

     key[] := 'array     ';

     key[] := 'begin     ';

     key[] := 'case      ';

     key[] := 'const     ';

     key[] := 'div       ';

     key[] := 'do        ';

     key[] := 'downto    ';

     key[] := 'else      ';

     key[] := 'end       ';

     key[] := 'for       ';

     key[] := 'function  ';

     key[] := 'if        ';

     key[] := 'mod       ';

     key[] := 'not       ';

     key[] := 'of        ';

     key[] := 'or        ';

     key[] := 'procedure ';

     key[] := 'program   ';

     key[] := 'record    ';

     key[] := 'repeat    ';

     key[] := 'then      ';

     key[] := 'to        ';

     key[] := 'type      ';

     key[] := 'until     ';

     key[] := 'var       ';

     key[] := 'while     ';

     ksy[] := andsy;    {定义保留字对应的符号}

     ksy[] := arraysy;

     ksy[] := beginsy;

     ksy[] := casesy;

     ksy[] := constsy;

     ksy[] := idiv;

     ksy[] := dosy;

     ksy[] := downtosy;

     ksy[] := elsesy;

     ksy[] := endsy;

     ksy[] := forsy;

     ksy[] := funcsy;

     ksy[] := ifsy;

     ksy[] := imod;

     ksy[] := notsy;

     ksy[] := ofsy;

     ksy[] := orsy;

     ksy[] := procsy;

     ksy[] := programsy;

     ksy[] := recordsy;

     ksy[] := repeatsy;

     ksy[] := thensy;

     ksy[] := tosy;

     ksy[] := typesy;

     ksy[] := untilsy;

     ksy[] := varsy;

     ksy[] := whilesy;

     sps['+'] := plus;    {定义特殊字符对应的sym}

     sps['-'] := minus;

     sps['*'] := times;

     sps['/'] := rdiv;

     sps['('] := lparent;

     sps[')'] := rparent;

     sps['='] := eql;

     sps[','] := comma;

     sps['['] := lbrack;

     sps[']'] := rbrack;

     sps[''''] := neq;

     sps['!'] := andsy;

     sps[';'] := semicolon;

   end { setup };

 procedure enterids;    {这个过程负责将全部标准类型的信息登陆到table中}

   begin

     enter('          ',vvariable,notyp,); { sentinel }

     enter('false     ',konstant,bools,);

     enter('true      ',konstant,bools,);

     enter('real      ',typel,reals,);

     enter('char      ',typel,chars,);

     enter('boolean   ',typel,bools,);

     enter('integer   ',typel,ints,);

     enter('abs       ',funktion,reals,);

     enter('sqr       ',funktion,reals,);

     enter('odd       ',funktion,bools,);

     enter('chr       ',funktion,chars,);

     enter('ord       ',funktion,ints,);

     enter('succ      ',funktion,chars,);

     enter('pred      ',funktion,chars,);

     enter('round     ',funktion,ints,);

     enter('trunc     ',funktion,ints,);

     enter('sin       ',funktion,reals,);

     enter('cos       ',funktion,reals,);

     enter('exp       ',funktion,reals,);

     enter('ln        ',funktion,reals,);

     enter('sqrt      ',funktion,reals,);

     enter('arctan    ',funktion,reals,);

     enter('eof       ',funktion,bools,);

     enter('eoln      ',funktion,bools,);

     enter('read      ',prozedure,notyp,);

     enter('readln    ',prozedure,notyp,);

     enter('write     ',prozedure,notyp,);

     enter('writeln   ',prozedure,notyp,);

     enter('          ',prozedure,notyp,);

   end;

 begin  { main }

   setup;    {初始化变量}

   constbegsys := [ plus, minus, intcon, realcon, charcon, ident ];    {常量的开始符号集合}

   typebegsys := [ ident, arraysy, recordsy ];    {类型的开始符号集合}

   blockbegsys := [ constsy, typesy, varsy, procsy, funcsy, beginsy ];    {分语句的开始符号集合}

   facbegsys := [ intcon, realcon, charcon, ident, lparent, notsy ];        {因子的开始符号集合}

   statbegsys := [ beginsy, ifsy, whilesy, repeatsy, forsy, casesy ];    {statement开始的符号集合}

   stantyps := [ notyp, ints, reals, bools, chars ];

   lc := ;        {重置pc}

   ll := ;        {重置当前行的长度}

   cc := ;        {重置当前行位置指针}

   ch := ' ';    {重置当前符号}

   errpos := ;    {重置错误位置}

   errs := [];    {重置错误集合}

   writeln( 'NOTE input/output for users program is console : ' );

   writeln;

   write( 'Source input file ?');    {代码输入文件}

   readln( inf );

   assign( psin, inf );

   reset( psin );

   write( 'Source listing file ?');    {代码输出文件}

   readln( outf );

   assign( psout, outf );

   rewrite( psout );

   assign ( prd, 'con' );

   write( 'result file : ' );    {结果输出文件}

   readln( fprr );

   assign( prr, fprr );

   reset ( prd );

   rewrite( prr );

   t := -;    {设置tab栈顶初值}

   a := ;    {设置atab栈顶初值}

   b := ;    {设置btab栈顶初始值}

   sx := ;    {设置stab栈顶初值}

   c2 := ;    {设置rconst栈顶初值}

   display[] := ;    {设置display初值}

   iflag := false;    {初始化一系列flag的值}

   oflag := false;

   skipflag := false;

   prtables := false;

   stackdump := false;

   insymbol;    {获得第一个sym}

   if sy <> programsy    {要求第一个符号是program关键字,不是的话就报错}

   then error()

   else begin

          insymbol;    {获取下一个符号}

          if sy <> ident    {应该是程序名,不是则报错}

          then error()

          else begin

                 progname := id;

                 insymbol;

                 if sy <> lparent

                 then error()

                 else repeat

                        insymbol;

                        if sy <> ident

                        then error()

                        else begin

                               if id = 'input     '

                               then iflag := true

                               else if id = 'output    '

                                    then oflag := true

                                    else error();

                               insymbol

                             end

                      until sy <> comma;

                 if sy = rparent

                 then insymbol

                 else error();

                 if not oflag then error()

               end

        end;

   enterids;

   with btab[] do

     begin

       last := t;

       lastpar := ;

       psize := ;

       vsize := ;

     end;

   block( blockbegsys + statbegsys, false,  );

   if sy <> period

   then error();

   emit();  { halt }

   if prtables

   then printtables;

   if errs = []

   then interpret

   else begin

          writeln( psout );

          writeln( psout, 'compiled with errors' );

          writeln( psout );

          errormsg;

        end;

   writeln( psout );

   close( psout );

   close( prr )

 end.

码农公寓

相关文章