编译原理——pl0文法（2）

(* 语法分析过程block *)
(* 参数：lev:这一次语法分析所在的层次 *)
(*       tx:符号表指针 *)
(*       fsys:用于出错恢复的单词集合 *)
procedure block(lev, tx: integer; fsys: symset);
var
  dx: integer; (* data allocation index *) (* 数据段内存分配指针，指向下一个被分配空间在数据段中的偏移位置 *)
  tx0: integer;  (* initial table index *) (* 记录本层开始时符号表位置 *)
  cx0: integer;  (* initial code index *) (* 记录本层开始时代码段分配位置 *)
  (* 登陆符号表过程enter *)
  (* 参数：k:欲登陆到符号表的符号类型 *)
  procedure enter(k: object1);
  begin (* enter object into table *)
    tx := tx + 1; (* 符号表指针指向一个新的空位 *)
    with table[tx] do (* 开始登录 *)
    begin
      name := id; (* name是符号的名字，对于标识符，这里就是标识符的名字 *)
      kind := k; (* 符号类型，可能是常量、变量或过程名 *)
      case k of (* 根据不同的类型进行不同的操作 *)
        constant: (* 如果是常量名 *)
        begin
          if num > amax then (* 在常量的数值大于允许的最大值的情况下 *)
          begin
            error(31); (* 抛出31号错误 *)
            num := 0; (* 实际登陆的数字以0代替 *)
          end;
          val := num (* 如是合法的数值，就登陆到符号表 *)
        end;
        variable: (* 如果是变量名 *)
        begin
          level := lev; (* 记下它所属的层次号 *)
          adr := dx; (* 记下它在当前层中的偏移量 *)
          dx := dx+1; (* 偏移量自增一，为下一次做好准备 *)
        end;
        procedur: (* 如果要登陆的是过程名 *)
          level := lev (* 记录下这个过程所在层次 *)
      end
    end
  end (* enter *);
  (* 登录符号过程没有考虑到重复的定义的问题。如果出现重复定义，则以最后一次的定义为准。*)
  (* 在符号表中查找指定符号所在位置的函数position *)
  (* 参数：id:要找的符号 *)
  (* 返回值：要找的符号在符号表中的位置，如果找不到就返回0 *)
  function position (id: alfa): integer;
  var
    i: integer;
  begin (* find identifier in table *)
    table[0].name := id; (* 先把id放入符号表0号位置 *)
    i := tx; (* 从符号表中当前位置也即最后一个符号开始找 *)
    while table[i].name <> id do (* 如果当前的符号与要找的不一致 *)
      i := i – 1; (* 找前面一个 *)
    position := i (* 返回找到的位置号，如果没找到则一定正好为0 *)
  end(* position *);
  (* 常量声明处理过程constdeclaration *)
  procedure constdeclaration;
  begin
    if sym = ident then (* 常量声明过程开始遇到的第一个符号必然应为标识符 *)
    begin
      getsym; (* 获取下一个token *)
      if sym in [eql, becomes] then (* 如果是等号或赋值号 *)
      begin
        if sym = becomes then (* 如果是赋值号(常量生明中应该是等号) *)
          error(1); (* 抛出1号错误 *)
        (* 这里其实自动进行了错误纠正使编译继续进行，把赋值号当作等号处理 *)
        getsym; (* 获取下一个token，等号或赋值号后应接上数字 *)
        if sym = number then (* 如果的确是数字 *)
        begin
          enter(constant); (* 把这个常量登陆到符号表 *)
          getsym (* 获取下一个token，为后面作准备 *)
        end
        else
          error(2) (* 如果等号后接的不是数字，抛出2号错误 *)
      end
      else
        error(3) (* 如果常量标识符后接的不是等号或赋值号，抛出3号错误 *)
    end
    else
      error(4) (* 如果常量声明过程遇到的第一个符号不为标识符，抛出4号错误 *)
  end(* constdeclaration *);
  (* 变量声明过程vardeclaration *)
  procedure vardeclaration;
  begin
    if sym = ident then (* 变量声明过程开始遇到的第一个符号必然应为标识符 *)
    begin
      enter(variable); (* 将标识符登陆到符号表中 *)
      getsym (* 获取下一个token，为后面作准备 *)
    end
    else
      error(4) (* 如果变量声明过程遇到的第一个符号不是标识符，抛出4号错误 *)
  end(* vardeclaration *);
  (* 列出当前一层类PCODE目标代码过程listcode *)
  procedure listcode;
  var
    i: integer;
  begin (* list code generated for this block *)
    if listswitch then (* 如果用户选择是要列出代码的情况下才列出代码 *)
    begin
      for i := cx0 to cx – 1 do (* 从当前层代码开始位置到当前代码位置-1处，即为本分程序块 *)
        with code[i] do
        begin
          writeln(i: 4, mnemonic[f]: 5, l: 3, a: 5); (* 显示出第i行代码的助记符和L与A操作数 *)
          (* 我修改的代码：原程序此处在输出i时，没有指定占4个字符宽度，不美观也与下面一句不配套。 *)
          writeln(fa, i: 4, mnemonic[f]: 5, l: 3, a: 5) (* 同时把屏显打印到文件 *)
        end;
    end
  end(* listcode *);
 (* 语句处理过程statement *)
  (* 参数说明：fsys: 如果出错可用来恢复语法分析的符号集合 *)
  procedure statement(fsys: symset);
  var
    i, cx1, cx2: integer;
    (* 表达式处理过程expression *)
    (* 参数说明：fsys: 如果出错可用来恢复语法分析的符号集合 *)
 
    procedure expression(fsys: symset);
    var
      addop: symbol;
      (* 项处理过程term *)
      (* 参数说明：fsys: 如果出错可用来恢复语法分析的符号集合 *)
      procedure term(fsys: symset);
      var
        mulop: symbol;
        (* 因子处理过程factor *)
        (* 参数说明：fsys: 如果出错可用来恢复语法分析的符号集合 *)
        procedure factor(fsys: symset);
        var
          i: integer;
        begin
          test(facbegsys, fsys, 24); (* 开始因子处理前，先检查当前token是否在facbegsys集合中。 *)
                                     (* 如果不是合法的token，抛24号错误，并通过fsys集恢复使语法处理可以继续进行 *)       
          while sym in facbegsys do (* 循环处理因子 *)
          begin
            if sym = ident then (* 如果遇到的是标识符 *)
            begin
              i := position(id); (* 查符号表，找到当前标识符在符号表中的位置 *)
              if i = 0 then (* 如果查符号表返回为0，表示没有找到标识符 *)
                error(11) (* 抛出11号错误 *)
              else
                with table[i] do (* 如果在符号表中找到了当前标识符的位置，开始生成相应代码 *)
                  case kind of
                    constant: gen(lit, 0, val); (* 如果这个标识符对应的是常量，值为val，生成lit指令，把val放到栈顶 *)
                    variable: gen(lod, lev – level, adr); (* 如果标识符是变量名，生成lod指令， *)
                                                          (* 把位于距离当前层level的层的偏移地址为adr的变量放到栈顶 *)
                    procedur: error(21) (* 如果在因子处理中遇到的标识符是过程名，出错了，抛21号错 *)
                  end;
              getsym (* 获取下一token，继续循环处理 *)
            end
            else
              if sym = number then (* 如果因子处理时遇到数字 *)
              begin
                if num > amax then (* 如果数字的大小超过允许最大值amax *)
                begin
                  error(31); (* 抛出31号错 *)
                  num := 0 (* 把数字按0值处理 *)
                end;
                gen(lit, 0, num); (* 生成lit指令，把这个数值字面常量放到栈顶 *)
                getsym (* 获取下一token *)
              end
              else
                if sym = lparen then (* 如果遇到的是左括号 *)
                begin
                  getsym; (* 获取一个token *)
                  expression( [rparen] + fsys ); (* 递归调用expression子程序分析一个子表达式 *)
                  if sym = rparen then (* 子表达式分析完后，应遇到右括号 *)
                    getsym (* 如果的确遇到右括号，读取下一个token *)
                  else
                    error(22) (* 否则抛出22号错误 *)
                end;
            test(fsys, facbegsys, 23) (* 一个因子处理完毕，遇到的token应在fsys集合中 *)
                                      (* 如果不是，抛23号错，并找到下一个因子的开始，使语法分析可以继续运行下去 *)
          end
        end(* factor *); 
 begin (* term *)
        factor([times, slash] + fsys); (* 每一个项都应该由因子开始，因此调用factor子程序分析因子 *)
        while sym in [times, slash] do (* 一个因子后应当遇到乘号或除号 *)
        begin
          mulop := sym; (* 保存当前运算符 *)
          getsym; (* 获取下一个token *)
          factor(fsys + [times, slash]); (* 运算符后应是一个因子，故调factor子程序分析因子 *)
          if mulop = times then (* 如果刚才遇到乘号 *)
            gen(opr, 0, 4) (* 生成乘法指令 *)
          else
            gen(opr, 0, 5) (* 不是乘号一定是除号，生成除法指令 *)
        end
      end (* term *);
    begin (* expression *)
      if sym in [plus, minus] then (* 一个表达式可能会由加号或减号开始，表示正负号 *)
      begin
        addop := sym; (* 把当前的正号或负号保存起来，以便下面生成相应代码 *)
        getsym; (* 获取一个token *)
        term(fsys + [plus, minus]); (* 正负号后面应该是一个项，调term子程序分析 *)
        if addop = minus then (* 如果保存下来的符号是负号 *)
          gen(opr, 0, 1) (* 生成一条1号操作指令：取反运算 *)
        (* 如果不是负号就是正号，不需生成相应的指令 *)
      end
      else (* 如果不是由正负号开头，就应是一个项开头 *)
        term(fsys + [plus, minus]); (* 调用term子程序分析项 *)
      while sym in [plus, minus] do (* 项后应是加运算或减运算 *)
      begin
        addop := sym; (* 把运算符保存下来 *)
        getsym; (* 获取下一个token，加减运算符后应跟的是一个项 *)
        term(fsys + [plus, minus]); (* 调term子程序分析项 *)
        if addop = plus then (* 如果项与项之间的运算符是加号 *)
          gen(opr, 0, 2) (* 生成2号操作指令：加法 *)
        else (* 否则是减法 *)
          gen(opr, 0, 3) (* 生成3号操作指令：减法 *)
      end
    end (* expression *); 
 (* 条件处理过程condition *)
    (* 参数说明：fsys: 如果出错可用来恢复语法分析的符号集合 *)
    procedure condition(fsys: symset);
    var
      relop: symbol; (* 用于临时记录token(这里一定是一个二元逻辑运算符)的内容 *)
    begin
      if sym = oddsym then (* 如果是odd运算符(一元) *)
      begin
        getsym; (* 获取下一个token *)
        expression(fsys); (* 对odd的表达式进行处理计算 *)
        gen(opr, 0, 6); (* 生成6号操作指令：奇偶判断运算 *)
      end
      else (* 如果不是odd运算符(那就一定是二元逻辑运算符) *)
      begin
        expression([eql, neq, lss, leq, gtr, geq] + fsys); (* 对表达式左部进行处理计算 *)
        if not (sym in [eql, neq, lss, leq, gtr, geq]) then (* 如果token不是逻辑运算符中的一个 *)
          error(20) (* 抛出20号错误 *)
        else
        begin
          relop := sym; (* 记录下当前的逻辑运算符 *)
          getsym; (* 获取下一个token *)
          expression(fsys); (* 对表达式右部进行处理计算 *)
          case relop of (* 如果刚才的运算符是下面的一种 *)
            eql: gen(opr, 0, 8); (* 等号：产生8号判等指令 *)
            neq: gen(opr, 0, 9); (* 不等号：产生9号判不等指令 *)
            lss: gen(opr, 0, 10); (* 小于号：产生10号判小指令 *)
            geq: gen(opr, 0, 11); (* 大于等号号：产生11号判不小于指令 *)
            gtr: gen(opr, 0, 12); (* 大于号：产生12号判大于指令 *)
            leq: gen(opr, 0, 13); (* 小于等于号：产生13号判不大于指令 *)
          end
        end
      end
    end (* condition *);