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 };
begin { statement }
if sym = ident then { 所谓"语句"可能是赋值语句，以标识符开头 }
begin
i := position(id); { 在符号表中查到该标识符所在位置 }
if i = 0 then { 如果没找到 }
error(11) { 抛出11号错误 }
else
if table[i].kind <> variable then { 如果在符号表中找到该标识符，但该标识符不是变量名 }
begin
error(12); { 抛出12号错误 }
i := 0 { i置0作为错误标志 }
end;
getsym; { 获得下一个token，正常应为赋值号 }
if sym = becomes then { 如果的确为赋值号 }
getsym { 获取下一个token，正常应为一个表达式 }
else
error(13); { 如果赋值语句的左部标识符号后所接不是赋值号，抛出13号错误 }
expression(fsys); { 处理表达式 }
if i <> 0 then { 如果不曾出错，i将不为0，i所指为当前语名左部标识符在符号表中的位置 }
with table[i] do
gen(sto, lev - level, adr) { 产生一行把表达式值写往指定内存的sto目标代码 }
end
else
if sym = readsym then { 如果不是赋值语句，而是遇到了read语句 }
begin
getsym; { 获得下一token，正常情况下应为左括号 }
if sym <> lparen then { 如果read语句后跟的不是左括号 }
error(34) { 抛出34号错误 }
else
repeat { 循环得到read语句括号中的参数表，依次产生相应的“从键盘读入”目标代码 }
getsym; { 获得一个token，正常应是一个变量名 }
if sym = ident then { 如果确为一个标识符 }
{ 这里略有问题，还应判断一下这个标识符是不是变量名，如果是常量名或过程名应出错 }
i := position(id) { 查符号表，找到它所在位置给i，找不到时i会为0 }
else
i := 0; { 不是标识符则有问题，i置0作为出错标志 }
if i = 0 then { 如果有错误 }
error(35) { 抛出35号错误 }
else { 否则生成相应的目标代码 }
with table[i] do
begin
gen(opr, 0, 16); { 生成16号操作指令:从键盘读入数字 }
gen(sto, lev - level, adr) { 生成sto指令，把读入的值存入指定变量所在的空间 }
end;
getsym { 获取下一个token，如果是逗号，则read语还没完，否则应当是右括号 }
until sym <> comma; { 不断生成代码直到read语句的参数表中的变量遍历完为止，这里遇到不是逗号，应为右括号 }
if sym <> rparen then { 如果不是我们预想中的右括号 }
begin
error(33); { 抛出33号错误 }
while not (sym in fsys) do { 依靠fsys集，找到下一个合法的token，恢复语法分析 }
getsym
end
else
getsym { 如果read语句正常结束，得到下一个token，一般为分号或end }
end
else
if sym = writesym then { 如果遇到了write语句 }
begin
getsym; { 获取下一token，应为左括号 }
if sym = lparen then { 如确为左括号 }
begin
repeat { 依次获取括号中的每一个值，进行输出 }
getsym; { 获得一个token，这里应是一个标识符 }
expression([rparen, comma] + fsys); { 调用expression过程分析表达式，用于出错恢复的集合中加上右括号和逗号 }
gen(opr, 0, 14) { 生成14号指令：向屏幕输出 }
until sym <> comma; { 循环直到遇到的不再是逗号，这时应是右括号 }
if sym <> rparen then { 如果不是右括号 }
error(33) { 抛出33号错误 }
else
getsym { 正常情况下要获取下一个token，为后面准备好 }
end;
gen(opr, 0, 15) { 生成一个15号操作的目标代码，功能是输出一个换行 }
{ 由此可知PL/0中的write语句与Pascal中的writeln语句类似，是带有输出换行的 }
end
else
if sym = callsym then { 如果是call语句 }
begin
getsym; { 获取token，应是过程名型标识符 }
if sym <> ident then { 如果call后跟的不是标识符 }
error(14) { 抛出14号错误 }
else
begin
i := position(id); { 从符号表中找出相应的标识符 }
if i = 0 then { 如果没找到 }
error(11) { 抛出11号错误 }
else
with table[i] do { 如果找到标识符位于符号表第i位置 }
if kind = procedur then { 如果这个标识符为一个过程名 }
gen(cal,lev-level,adr) { 生成cal目标代码，呼叫这个过程 }
else
error(15); { 如果call后跟的不是过程名，抛出15号错误 }
getsym { 获取下一token，为后面作准备 }
end
end
else
if sym = ifsym then { 如果是if语句 }
begin
getsym; { 获取一token应是一个逻辑表达式 }
condition([thensym, dosym] + fsys); { 对逻辑表达式进行分析计算，出错恢复集中加入then和do语句 }
if sym = thensym then { 表达式后应遇到then语句 }
getsym { 获取then后的token，应是一语句 }
else
error(16); { 如果if后没有then，抛出16号错误 }
cx1 := cx; { 记下当前代码分配指针位置 }
gen(jpc, 0, 0); { 生成条件跳转指令，跳转位置暂时填0，分析完语句后再填写 }
statement(fsys); { 分析then后的语句 }
code[cx1].a:=cx { 上一行指令(cx1所指的)的跳转位置应为当前cx所指位置 }
end
else
if sym = beginsym then { 如果遇到begin }
begin
getsym; { 获取下一个token }
statement([semicolon, endsym] + fsys);{ 对begin与end之间的语句进行分析处理 }
while sym in [semicolon] + statbegsys do { 如果分析完一句后遇到分号或语句开始符循环分析下一句语句 }
begin
if sym = semicolon then { 如果语句是分号（可能是空语句） }
getsym { 获取下一token继续分析 }
else
error(10); { 如果语句与语句间没有分号，出10号错 }
statement([semicolon, endsym] + fsys) { 分析一个语句 }
end;
if sym = endsym then { 如果语句全分析完了，应该遇到end }
getsym { 的确是end，读下一token }
else
error(17) { 如果不是end，抛出17号错 }
end
else
if sym = whilesym then { 如果遇到while语句 }
begin
cx1 := cx; { 记下当前代码分配位置，这是while循环的开始位置 }
getsym; { 获取下一token，应为一逻辑表达式 }
condition([dosym] + fsys); { 对这个逻辑表达式进行分析计算 }
cx2 := cx; { 记下当前代码分配位置，这是while的do中的语句的开始位置 }
gen(jpc, 0, 0); { 生成条件跳转指令，跳转位置暂时填0 }
if sym = dosym then { 逻辑表达式后应为do语句 }
getsym { 获取下一token }
else
error(18); { if后缺少then，抛出18号错误 }
statement(fsys); { 分析do后的语句块 }
gen(jmp, 0, cx1); { 循环跳转到cx1位置，即再次进行逻辑判断 }
code[cx2].a := cx { 把刚才填0的跳转位置改成当前位置，完成while语句的处理 }
end;
test(fsys, [], 19) { 至此一个语句处理完成，一定会遇到fsys集中的符号，如果没有遇到，就抛19号错 }
end{ statement };
begin { block }
dx := 3; { 地址指示器给出每层局部量当前已分配到的相对位置。
置初始值为3的原因是：每一层最开始的位置有三个空间用于存放静态链SL、动态链DL和返回地址RA }
tx0 := tx; { 初始符号表指针指向当前层的符号在符号表中的开始位置 }
table[tx].adr := cx; { 符号表当前位置记下当前层代码的开始位置 }
gen(jmp, 0, 0); { 产生一行跳转指令，跳转位置暂时未知填0 }
if lev > levmax then { 如果当前过程嵌套层数大于最大允许的套层数 }
error(32); { 发出32号错误 }
repeat { 开始循环处理源程序中所有的声明部分 }
if sym = constsym then { 如果当前token是const保留字，开始进行常量声明 }
begin
getsym; { 获取下一个token，正常应为用作常量名的标识符 }
repeat { 反复进行常量声明 }
constdeclaration; { 声明以当前token为标识符的常量 }
while sym = comma do { 如果遇到了逗号则反复声明下一个常量 }
begin
getsym; { 获取下一个token，这里正好应该是标识符 }
constdeclaration { 声明以当前token为标识符的常量 }
end;
if sym = semicolon then { 如果常量声明结束，应遇到分号 }
getsym { 获取下一个token，为下一轮循环做好准备 }
else
error(5) { 如果常量声明语句结束后没有遇到分号则发出5号错误 }
until sym <> ident { 如果遇到非标识符，则常量声明结束 }
end;
{ 此处的常量声明的语法与课本上的EBNF范式有不同之处：
它可以接受像下面的声明方法，而根据课本上的EBNF范式不可得出下面的语法：
const a = 3, b = 3; c = 6; d = 7, e = 8;
即它可以接受分号或逗号隔开的常量声明，而根据EBNF范式只可接受用逗号隔开的声明 }
if sym = varsym then { 如果当前token是var保留字，开始进行变量声明,与常量声明类似 }
begin
getsym; { 获取下一个token，此处正常应为用作变量名的一个标识符 }
repeat { 反复进行变量声明 }
vardeclaration; { 以当前token为标识符声明一个变量 }
while sym = comma do { 如果遇到了逗号则反复声明下一个变量 }
begin
getsym; { 获取下一个token，这里正好应该是标识符 }
vardeclaration; { 声明以当前token为标识符的变量 }
end;
if sym = semicolon then { 如果变量声明结束，应遇到分号 }
getsym { 获取下一个token，为下一轮循环做好准备 }
else
error(5) { 如果变量声明语句结束后没有遇到分号则发出5号错误 }
until sym <> ident; { 如果遇到非标识符，则变量声明结束 }
{ 这里也存在与上面的常量声明一样的毛病：与PL/0的语法规范有冲突。 }
end;
while sym = procsym do { 循环声明各子过程 }
begin
getsym; { 获取下一个token，此处正常应为作为过程名的标识符 }
if sym = ident then { 如果token确为标识符 }
begin
enter(procedur); { 把这个过程登录到名字表中 }
getsym { 获取下一个token，正常情况应为分号 }
end
else
error(4); { 否则抛出4号错误 }
if sym = semicolon then { 如果当前token为分号 }
getsym { 获取下一个token，准备进行语法分析的递归调用 }
else
error(5); { 否则抛出5号错误 }
block(lev + 1, tx, [semicolon] + fsys); { 递归调用语法分析过程，当前层次加一，同时传递表头索引、合法单词符 }
if sym = semicolon then { 递归返回后当前token应为递归调用时的最后一个
begin getsym;{ 获取下一个token }
test( statbegsys+[ident,procsym],fsys,6)
{ 检查当前token是否合法，不合法则用fsys恢复语法分析同时抛6号错 }
end
else error(5){ 如果过程声明后的符号不是分号，抛出5号错误 }
end;
test( statbegsys+[ident],declbegsys,7)
{ 检查当前状态是否合法，不合法则用声明开始符号作出错恢复、抛7号错 }
until not ( sym in declbegsys );
{ 直到声明性的源程序分析完毕，继续向下执行，分析主程序 }
code[table[tx0].adr].a := cx; { back enter statement code's start adr. }
with table[tx0] do{ 在符号表中记录 }
begin
adr := cx; { code's start address }
end;
cx0 := cx; { 记下当前代码分配位置 }
gen(int,0,dx); { 生成分配空间指令，分配dx个空间 }
statement( [semicolon,endsym]+fsys); { 处理当前遇到的语句 }
gen(opr,0,0); { 生成从子程序返回操作指令 }
test( fsys, [],8 ); { 用fsys检查当前状态是否合法，不合法则抛8号错 }
listcode; { 列出本层的类PCODE代码 }
end { block };