(* 语法分析过程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 *);
