program pl0(input,output)); (* PL/0编译程序与代码生成解释运行程序 *)
(* PL/0 compiler with code generation *)
label 99; (* 声明出错跳转标记 *)
const (* 常量定义 *)
norw = 11; (* of reserved words *) (* 保留字的个数 *)
txmax = 100; (* length of identifier table *) (* 标识符表的长度（容量） *)
nmax = 14; (* max number of digits in numbers *) (* 数字允许的最长位数 *)
al = 10; (* length of identifiers *) (* 标识符最长长度 *)
amax = 2047; (* maximum address *) (* 寻址空间 *)
levmax = 3; (* max depth of block nesting *) (* 最大允许的块嵌套层数 *)
cxmax = 200; (* size of code array *) (* 类PCODE目标代码数组长度（可容纳代码行数） *)
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, writesym, readsym, dosym, callsym,
constsym, varsym, procsym); (* symobl类型标识了不同类型的词汇 *)
alfa = packed array[1..al] of char; (* alfa类型用于标识符 *)
object1 = (constant, variable, procedur); (* object1为三种标识符的类型 *)
symset = set of symbol; (* symset是symbol类型的一个集合类型，可用于存放一组symbol *)
fct = (lit, opr, lod, sto, cal, int, jmp, jpc); (* fct类型分别标识类PCODE的各条指令 *)
instruction = packed record
f: fct; (* function code *)
l: 0..levmax; (* level *)
a: 0..amax; (* displacement addr *)
end; (* 类PCODE指令类型，包含三个字段：指令f、层差l和另一个操作数a *)
(*
lit 0, a load constant a
opr 0, a execute opr a
lod l, a load variable l, a
sto l, a store variable l, a
cal l, a call procedure a at level l
int 0, a increment t-register by a
jmp 0, a jump to a
jpc 0, a jump conditional to a
*)
var (* 全局变量定义 *)
ch: char; (* last char read *) (* 主要用于词法分析器，存放最近一次从文件中读出的字符 *)
sym: symbol; (* last symbol read *) (* 词法分析器输出结果之用，存放最近一次识别出来的token的类型 *)
id: alfa; (* last identifier read *) (* 词法分析器输出结果之用，存放最近一次识别出来的标识符的名字 *)
num: integer; (* last number read *) (* 词法分析器输出结果之用，存放最近一次识别出来的数字的值 *)
cc: integer; (* character count *) (* 行缓冲区指针 *)
ll: integer; (* line length *) (* 行缓冲区长度 *)
kk: integer; (* 引入此变量是出于程序性能考虑，见getsym过程注释 *)
cx: integer; (* code allocation index *) (* 代码分配指针，代码生成模块总在cx所指位置生成新的代码 *)
line: array[1..81] of char; (* 行缓冲区，用于从文件读出一行，供词法分析获取单词时之用 *)
a: alfa; (* 词法分析器中用于临时存放正在分析的词 *)
code: array[0..cxmax] of instruction; (* 生成的类PCODE代码表，存放编译得到的类PCODE代码 *)
word: array[1..norw] of alfa; (* 保留字表 *)
wsym: array[1..norw] of symbol; (* 保留字表中每一个保留字对应的symbol类型 *)
ssym: array[' '..'^'] of symbol; (* 一些符号对应的symbol类型表 *)
(* wirth uses “array[char]” here *)
mnemonic: array[fct] of packed array[1..5] of char;(* 类PCODE指令助记符表 *)
declbegsys, statbegsys, facbegsys: symset; (* 声明开始、表达式开始和项开始符号集合 *)
table: array[0..txmax] of record (* 符号表 *)
name: alfa; (* 符号的名字 *)
case kind: object1 of (* 符号的类型 *)
constant: (* 如果是常量名 *)
(val: integer); (* val中放常量的值 *)
variable, procedur: (* 如果是变量名或过程名 *)
(level, adr, size: integer) (* 存放层差、偏移地址和大小 *)
(* “size” lacking in orginal. I think it belons here *)
end;
fin, fout: text; (* fin文本文件用于指向输入的源程序文件，fout程序中没有用到 *)
sfile: string; (* 存放PL/0源程序文件的文件名 *)
(* 出错处理过程error *)
(* 参数：n:出错代码 *)
procedure error(n: integer);
begin
writeln(‘****’, ‘ ‘: cc-1, ‘!’, n:2); (* 在屏幕cc-1位置显示!与出错代码提示，由于cc
是行缓冲区指针，所以!所指位置即为出错位置 *)
writeln(fa1, ‘****’, ‘ ‘: cc-1, ‘!’, n:2); (* 在文件cc-1位置输出!与出错代码提示 *)
err := err + 1 (* 出错总次数加一 *)
end (* error *);
(* 词法分析过程getsym *)
procedure getsym;
var
i, j, k: integer;
(* 读取原程序中下一个字符过程getch *)
procedure getch;
begin
if cc = ll then (* 如果行缓冲区指针指向行缓冲区最后一个字符就从文件读一行到行缓冲区 *)
begin
if eof(fin) then (* 如果到达文件末尾 *)
begin
write(‘Program incomplete’); (* 出错，退出程序 *)
close(fin);
exit;
end;
ll := 0; (* 行缓冲区长度置0 *)
cc := 0; (* 行缓冲区指针置行首 *)
write(cx: 4, ‘ ‘); (* 输出cx值，宽度为4 *)
write(fa1, cx: 4, ‘ ‘); (* 输出cx值，宽度为4到文件 *)
while not eoln(fin) do (* 当未到行末时 *)
begin
ll := ll + 1; (* 行缓冲区长度加一 *)
read(fin, ch); (* 从文件读入一个字符到 ch *)
write(ch); (* 在屏幕输出ch *)
write(fa1, ch); (* 把ch输出到文件 *)
line[ll] := ch; (* 把读到的字符存入行缓冲区相应的位置 *)
end;
(* 可见，PL/0源程序要求每行的长度都小于81个字符 *)
writeln;
ll := ll + 1; (* 行缓冲区长度加一，用于容纳即将读入的回车符CR *)
read(fin, line[ll]);(* 把#13(CR)读入行缓冲区尾部 *)
read(fin, ch); (* 我添加的代码。由于PC上文本文件换行是以#13#10(CR+LF)表示的，
所以要把多余的LF从文件读出，这里放在ch变量中是由于ch变量的
值在下面即将被改变，把这个多余值放在ch中没有问题 *)
writeln(fa1);
end;
cc := cc + 1; (* 行缓冲区指针加一，指向即将读到的字符 *)
ch := line[cc] (* 读出字符，放入全局变量ch *)
end (* getch *);
begin (* getsym *)
while (ch = ‘ ‘) do getch;
if ch in ['a'..'z'] then (* 如果读出的字符是一个字母，说明是保留字或标识符 *)
begin
k := 0; (* 标识符缓冲区指针置0 *)
repeat (* 这个循环用于依次读出源文件中的字符构成标识符 *)
if k < al then (* 如果标识符长度没有超过最大标识符长度(如果超过，就取前面一部分，把多余的抛弃) *)
begin
k := k + 1;
a[k] := ch;
end;
getch (* 读下一个字符 *)
until not (ch in ['a'..'z','0'..'9']); (* 直到读出的不是字母或数字，由此可知PL/0的标识符构成规则是:
以字母开头，后面跟若干个字母或数字 *)
if k >= kk then (* 如果当前获得的标识符长度大于等于kk *)
kk := k (* 令kk为当前标识符长度 *)
else
repeat (* 这个循环用于把标识符缓冲后部没有填入相应字母或空格的空间用空格补足 *)
a[kk] := ‘ ‘;
kk := kk – 1
until kk = k;
(* 在第一次运行这个过程时，kk的值为al，即最大标识符长度，如果读到的标识符长度小于kk，就把a数组的后部没有字母的空间用空格补足。
这时，kk的值就成为a数组前部非空格字符的个数。以后再运行getsym时，如果读到的标识符长度大于等于kk，就把kk的值变成当前标识符的长度。
这时就不必在后面填空格了，因为它的后面肯定全是空格。反之如果最近读到的标识符长度小于kk，那就需要从kk位置向前，把超过当前标识长度的空间填满空格。
以上的这样一个逻辑，完全是出于程序性能的上考虑。其实完全可以简单的把a数组中a[k]元素以后的空间不管三七二十一全填空格。*)
(* 下面开始二分法查找看读出的标识符是不是保留字之一 *)
id := a; (* 最后读出标识符等于a *)
i := 1; (* i指向第一个保留字 *)
j := norw; (* j指向最后一个保留字 *)
repeat
k := (i + j) div 2; (* k指向中间一个保留字 *)
if id <= word[k] then (* 如果当前的标识符小于k所指的保留字 *)
j := k – 1; (* 移动j指针 *)
if id >= word[k] then (* 如果当前的标识符大于k所指的保留字 *)
i := k + 1 (* 移动i指针 *)
until i > j; (* 循环直到找完保留字表 *)
if i – 1 > j then (* 如果i – 1 > j表明在保留字表中找到相应的项，id中存的是保留字 *)
sym := wsym[k] (* 找到保留字，把sym置为相应的保留字值 *)
else
sym := ident (* 未找到保留字，把sym置为ident类型，表示是标识符 *)
end(* 至此读出字符为字母即对保留字或标识符的处理结束 *)
else (* 如果读出字符不是字母 *)
if ch in ['0'..'9'] then (* 如果读出字符是数字 *)
begin (* number *) (* 开始对数字进行处理 *)
k := 0; (* 数字位数 *)
num := 0; (* 数字置为0 *)
sym := number; (* 置sym为number，表示这一次读到的是数字 *)
repeat (* 这个循环依次从源文件中读出字符，组成数字 *)
num := 10 * num + (ord(ch) – ord(’0′)); (* num * 10加上最近读出的字符ASCII减’0′的ASCII得到相应的数值 *)
k := k + 1; (* 数字位数加一 *)
getch
until not (ch in ['0'..'9']); (* 直到读出的字符不是数字为止 *)
if k > nmax then (* 如果组成的数字位数大于最大允许的数字位数 *)
error(30) (* 发出30号错 *)
end(* 至此对数字的识别处理结束 *)
else
if ch = ‘:’ then (* 如果读出的不字母也不是数字而是冒号 *)
begin
getch; (* 再读一个字符 *)
if ch = ‘=’ then (* 如果读到的是等号，正好可以与冒号构成赋值号 *)
begin
sym := becomes; (* sym的类型设为赋值号becomes *)
getch (* 再读出下一个字 *)
end
else
sym := nul; (* 如果不是读到等号，那单独的一个冒号就什么也不是 *)
end(* 以上完成对赋值号的处理 *)
else (* 如果读到不是字母也不是数字也不是冒号 *)
if ch = ‘<’ then (* 如果读到小于号 *)
begin
getch; (* 再读一个字符 *)
if ch = ‘=’ then (* 如果读到等号 *)
begin
sym := leq; (* 购成一个小于等于号 *)
getch (* 读一个字符 *)
end
else (* 如果小于号后不是跟的等号 *)
sym := lss (* 那就是一个单独的小于号 *)
end
else (* 如果读到不是字母也不是数字也不是冒号也不是小于号 *)
if ch = ‘>’ then (* 如果读到大于号，处理过程类似于处理小于号 *)
begin
getch; (* 再读一个字符 *)
if ch = ‘=’ then (* 如果读到等号 *)
begin
sym := geq; (* 购成一个大于等于号 *)
getch (* 读一个字符 *)
end
else (* 如果大于号后不是跟的等号 *)
sym := gtr (* 那就是一个单独的大于号 *)
end
else(* 如果读到不是字母也不是数字也不是冒号也不是小于号也不是大于号 *)
begin (* 那就说明它不是标识符/保留字，也不是复杂的双字节操作符，应该是一个普通的符号 *)
sym := ssym[ch]; (* 直接成符号表中查到它的类型，赋给sym *)
getch (* 读下一个字符 *)
end
(* 整个if语句判断结束 *)
end (* getsym *);
(* 词法分析过程getsym总结：从源文件中读出若干有效字符，组成一个token串，识别它的类型为保留字/标识符/数字或是其它符号。如果是保留字，把sym置成相应的保留字类型，如果是标识符，把sym置成ident表示是标识符，于此同时，id变量中存放的即为保留字字符串或标识符名字。如果是数字，把sym置为number,同时num变量中存放该数字的值。如果是其它的操作符，则直接把sym置成相应类型。经过本过程后ch变量中存放的是下一个即将被识别的字符 *)
(* 目标代码生成过程gen *)
(* 参数：x:要生成的一行代码的助记符 *)
(* y, z:代码的两个操作数 *)
(* 本过程用于把生成的目标代码写入目标代码数组，供后面的解释器解释执行 *)
procedure gen(x: fct; y, z: integer);
begin
if cx > cxmax then (* 如果cx>cxmax表示当前生成的代码行号大于允许的最大代码行数 *)
begin
write(‘program too long’); {goto 99}(* 输出”程序太长”，退出 *)
end;
with code[cx] do
begin f := x; l := y; a := z
end;
cx := cx + 1
end {gen};
(* 测试当前单词是否合法过程test *)
(* 参数：s1:当语法分析进入或退出某一语法单元时当前单词符合应属于的集合 *)
(* s2:在某一出错状态下，可恢复语法分析正常工作的补充单词集合 *)
(* n:出错信息编号，当当前符号不属于合法的s1集合时发出的出错信息 *)
procedure test(s1, s2: symset; n: integer);
begin
if not (sym in s1) then (* 如果当前符号不在s1中 *)
begin
error(n); (* 发出n号错误 *)
s1 := s1 + s2; (* 把s2集合补充进s1集合 *)
while not (sym in s1) do (* 通过循环找到下一个合法的符号，以恢复语法分析工作 *)
getsym
end
end (* test *);
