学校编译课的作业之一,要求阅读两个较为简单的编译器的代码并做注释, 个人感觉是一次挺有意义的锻炼, 将自己的心得分享出来与一同在进步的同学们分享. 今后有时间再做进一步的更新和总结,其中可能有不少错误,也请各位大佬不吝指正. 代码可以通过使用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 = 13; { no. of reserved words } {保留字的数目}
txmax = 100; { length of identifier table } {符号表长度}
nmax = 14; { max. no. of digits in numbers } {数字的最大长度}
al = 10; { length of identifiers } {标识符的最大长度}
amax = 2047; { maximum address } {相对地址最大值}
levmax = 3; { maximum depth of block nesting } {最大嵌套层数}
cxmax = 200; { 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[1..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 : 0..levmax; { level } {嵌套层次}
a : 0..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[1..81] of char; {缓冲一行代码}
a : alfa; {用来存储symbol的变量}
code : array[0..cxmax] of instruction; {用来保存编译后的PCODE代码，最大容量为cxmax}
word : array[1..norw] of alfa; {保留字表}
wsym : array[1..norw] of symbol; {保留字表中每个保留字对应的symbol类型}
ssym : array[char] of symbol; {符号对应的symbol类型}
mnemonic : array[fct] of {助记符}
packed array[1..5] of char;
declbegsys, statbegsys, facbegsys : symset; {声明开始，表达式开始、项开始的符号集合}
table : array[0..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-1, '^', n:2 ); {报错提示信息，'^'指向出错位置，并提示错误类型}
err := err+1 {错误次数+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 := 0; {将行长度重置}
cc := 0; {将行指针重置}
write(cx:4,' '); { print code address } {输出代码地址，宽度为4}
while not eoln(fin) do {当没有到行末时}
begin
ll := ll+1; {将行缓冲区的长度+1}
read(fin,ch); {从文件中读取一个字符到ch中}
write(ch); {控制台输出ch}
line[ll] := ch {把这个字符放到当前行末尾}
end;
writeln; {换行}
readln(fin); {源文件读取从下一行开始}
ll := ll+1; {行长度计数加一}
line[ll] := ' ' { process end-line } {行数组最后一个元素为空格}
end;
cc := cc+1; {行指针+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 := 0; {标识符指针置零，这个量用来统计标识符长度}
repeat {循环}
if k < al {如果k的大小小于标识符的最大长度}
then begin
k := k+1; {k++}
a[k] := ch {将ch写入标识符暂存变量a}
end;
getch {获取下一个字符}
until not( ch in ['a'..'z','0'..'9']); {直到读出的不是数字或字母的时候，标识符结束}
if k >= kk { kk : last identifier length } {若k比kk大}
then kk := k {kk记录当前标识符的长度k}
else repeat {循环}
a[kk] := ' '; {标识符最后一位为空格}
kk := kk-1 {k--}
until kk = k; {直到kk等于当前标识符的长度，这样做的意义是防止上一个标识符存在a中的内容影响到当前标识符，比如上一个标识符为“qwerty”，现在的标识符为“abcd”，如果不清后几位则a中会保存"abcdty"，这显然是错误的}
id := a; {id保存标识符名}
i := 1; {i指向第一个保留字}
j := norw; { binary search reserved word table } {二分查找保留字表，将j设为保留字的最大数目}
repeat
k := (i+j) div 2; {再次用到k，但这里只是作为二分查找的中间变量}
if id <= word[k] {若当前标识符小于或等于保留字表中的第k个，这里的判断依据的是字典序，那么我们可以推测符号表是按照字典序保存的}
then j := k-1; {j = k-1}
if id >= word[k] {若当前标识符大于或等于保留字表中的第k个}
then i := k+1 {i = k+1}
until i > j; {查找结束条件}
if i-1 > j {找到了}
then sym := wsym[k] {将找到的保留字类型赋给sym}
else sym := ident {未找到则把sym置为ident类型，表示是标识符}
end
else if ch in ['0'..'9'] {如果字符是数字}
then begin { number }
k := 0; {这里的k用来记录数字的位数}
num := 0; {num保存数字}
sym := number; {将标识符设置为数字}
repeat {循环开始}
num := 10*num+(ord(ch)-ord('0')); {将数字字符转换为数字并拼接起来赋给num}
k := k+1; {k++}
getch {继续读字符}
until not( ch in ['0'..'9']); {直到输入的不再是数字}
if k > nmax {如果数字的位数超过了数字允许的最大长度}
then error(30) {报错}
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+1 {将当前代码行数之计数加一}
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+1; {符号表序号加一,指向一个空表项}
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); {报30号错误}
num := 0 {将常量置零}
end;
val := num {val保存该常量的值,结合上句可以看出,如果超过限制则保存0}
end;
variable : begin {对变量}
level := lev; {记录所属层次}
adr := dx; {记录变量在当前层中的偏移量}
dx := dx+1 {偏移量+1,位下一次插入做准备}
end;
prosedure: level := lev; {对过程,记录所属层次}
end
end
end; { enter }
function position ( id : alfa ): integer; {查找符号表的函数,输入id为需要寻找的符号,}
var i : integer; {声明记录变量}
begin
table[0].name := id; {把id放到符号表0号位置}
i := tx; {将i设置为符号表的最后一个位置,因为符号表是栈式结构,因此按层次逆序查找}
while table[i].name <> id do {如果当前表项的name和id不同}
i := i-1; {再向前找}
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(1); {报一号错误,因为声明应该使用等号}
getsym; {获取下一个sym类型}
if sym = number {如果读到的是数字}
then begin
enter(constant); {将该常量入表}
getsym {获取下一个sym类型}
end
else error(2) {如果等号后面不是数字,报2号错误}
end
else error(3) {如果常量标识符后面接的不是等号或赋值符号,报三号错误}
end
else error(4) {如果常量声明第一个符号不是标识符,报4号错误}
end; { constdeclaration } {常量声明结束}
procedure vardeclaration; {变量声明过程}
begin
if sym = ident {变量声明要求第一个sym为标识符}
then begin
enter(variable); {将该变量入表}
getsym {获取下一个sym类型}
end
else error(4) {如果第一个sym不是标识符,抛出4号错误}
end; { vardeclaration }
procedure listcode; {列出PCODE的过程}
var i : integer; {声明计数变量}
begin
for i := cx0 to cx-1 do {所有生成的代码}
with code[i] do {对于每一行代码}
writeln( i:4, mnemonic[f]:7,l:3, a:5) {格式化输出,分别输出序号,指令的助记符,层次,地址.实际的输出效果和我们实际的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, 24 ); {测试单词的合法性,判别当前sym是否在facbegsys中,后者在main中定义,如果不在报24号错误}
while sym in facbegsys do {循环处理因子}
begin
if sym = ident {如果识别到标识符}
then begin
i := position(id); {查表,记录其在符号表中的位置,保存至i}
if i= 0 {如果i为0,表示没查到}
then error(11) {报11号错误}
else
with table[i] do {对第i个表项的内容}
case kind of {按照表项的类型执行不同的操作}
constant : gen(lit,0,val); {如果是常量类型,生成lit指令,操作数为0,val}
variable : gen(lod,lev-level,adr); {如果是变量类型,生成lod指令,操作数为lev-level,adr}
prosedure: error(21) {如果因子处理中识别到了过程标识符,报21号错误}
end;
getsym {获取下一个sym类型}
end
else if sym = number {如果识别到数字}
then begin
if num > amax {判别数字是否超过规定上限}
then begin
error(30); {超过上限,报30号错误}
num := 0 {将数字重置为0}
end;
gen(lit,0,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) {报22号错误}
end;
test(fsys,[lparen],23) {测试结合是否在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,0,4 ) {生成opr指令,乘法指令}
else gen( opr,0,5) {生成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,0,1) {生成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,0,2) {生成opr指令,完成加法运算}
else gen( opr,0,3) {否则生成减法指令}
end
end; { expression }
procedure condition( fsys : symset ); {条件处理过程}
var relop : symbol; {临时变量}
begin
if sym = oddsym {如果当天符号是odd运算符}
then begin
getsym; {获取下一个sym类型}
expression(fsys); {调用表达式分析过程}
gen(opr,0,6) {生成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) {报20号错误}
else begin
relop := sym; {记录当前符号类型}
getsym; {获取下一个sym类型}
expression(fsys); {调用表达式分析过程对表达式进行分析}
case relop of {根据当前符号类型不同完成不同的操作}
eql : gen(opr,0,8); {如果是等号,生成opr8号指令,判断是否相等}
neq : gen(opr,0,9); {如果是不等号,生成opr9号指令,判断是否不等}
lss : gen(opr,0,10); {如果是小于号,生成opr10号指令,判断是否小于}
geq : gen(opr,0,11); {如果是大于等于号,生成opr11号指令,判断是否大于等于}
gtr : gen(opr,0,12); {如果是大于号,生成opr12号指令,判断是否大于}
leq : gen(opr,0,13); {如果是小于等于号,生成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 {如果返回0则是没找到}
then error(11) {抛出11号错误}
else if table[i].kind <> variable {如果在符号表中找到了该符号,但该符号的类型不是变量}
then begin { giving value to non-variation } {那么现在的操作属于给非变量赋值}
error(12); {报12号错误}
i := 0 {将符号表标号置零}
end;
getsym; {获取下一个sym类型}
if sym = becomes {如果读到的是赋值符号}
then getsym {获取下一个sym类型}
else error(13); {如果读到的不是赋值符号,报13号错误}
expression(fsys); {赋值符号的后面可以跟表达式,因此调用表达式处理子程序}
if i <> 0 {如果符号表中找到了合法的符号}
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) {报14号错误}
else begin {如果没有报错}
i := position(id); {记录当前符号在符号表中的位置}
if i = 0 {如果没有找到}
then error(11) {报11号错误}
else {如果找到了}
with table[i] do {对第i个表项做如下操作}
if kind = prosedure {如果该表项的种类为过程}
then gen(cal,lev-level,adr) {生成cal代码用来实现call操作}
else error(15); {如果种类不为过程类型,报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(16); {如果条件后面接的不是then,报16号错误}
cx1 := cx; {记录当前的生成代码位置}
gen(jpc,0,0); {生成条件跳转指令,跳转位置暂填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); {否则报10号错误}
statement([semicolon,endsym]+fsys) {继续分析}
end;
if sym = endsym {如果读到了end关键字}
then getsym {获取下一个sym类型}
else error(17) {报17号错误}
end
else if sym = whilesym {如果读到了while关键字}
then begin
cx1 := cx; {记录当前生成代码的行数指针}
getsym; {获取下一个sym类型}
condition([dosym]+fsys); {因为while后需要添加循环条件,因此调用条件语句的分析过程}
cx2 := cx; {记录在分析完条件之后的生成代码的位置,也是do开始的位置}
gen(jpc,0,0); {生成一个条件跳转指令,但是跳转位置(a)置零}
if sym = dosym {条件后应该接do关键字}
then getsym {获取下一个sym类型}
else error(18); {如果没接do,报18号错误}
statement(fsys); {分析处理循环节中的语句}
gen(jmp,0,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 = 0 {如果i为0,说明符号表中没有找到id对应的符号}
then error(11) {报11号错误}
else if table[i].kind <> variable {如果找到了,但该符号的类型不是变量}
then begin
error(12); {报12号错误,不能像常量和过程赋值}
i := 0 {将i置零}
end
else with table[i] do {如果是变量类型}
gen(red,lev-level,adr) {生成一条red指令,读取数据}
end
else error(4); {如果左括号后面跟的不是标识符,报4号错误}
getsym; {获取下一个sym类型}
until sym <> comma {知道现在的符号不是都好,循环结束}
else error(40); {如果read后面跟的不是左括号,报40号错误}
if sym <> rparen {如果上述内容之后接的不是右括号}
then error(22); {报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,0,0); {生成一个wrt海曙，用来输出内容}
until sym <> comma; {知道读取到的sym不是逗号}
if sym <> rparen {如果内容结束没有右括号}
then error(22); {报22号错误}
getsym {获取下一个sym类型}
end
else error(40) {如果write后面没有跟左括号}
end;
test(fsys,[],19) {测试当前字符是否合法,如果没有出现在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; {记录运行栈空间的栈顶位置,设置为3是因为需要预留SL,DL,RA的空间}
tx0 := tx; {记录当前符号表的栈顶位置}
table[tx].adr := cx; {符号表当前位置的偏移地址记录下一条生成代码开始的位置}
gen(jmp,0,0); { jump from declaration part to statement part } {产生一条jmp类型的无条件跳转指令,跳转位置未知}
if lev > levmax {当前过程所处的层次大于允许的最大嵌套层次}
then error(32); {报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) {如果没有分号,报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) {如果未读到分号,则报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); {如果第一个符号不是标识符类型,报4号错误}
if sym = semicolon {如果读到了分号,说明proc声明结束}
then getsym {获取下一个sym类型}
else error(5); {如果声明过程之后没有跟分号,报5号错误}
block(lev+1,tx,[semicolon]+fsys); {执行分程序的分析过程}
if sym = semicolon {递归调用返回后应该接分号}
then begin {如果接的是分号}
getsym; {获取下一个sym类型}
test( statbegsys+[ident,procsym],fsys,6) {测试当前的sym是否合法}
end
else error(5) {如果接的不是分号,报5号错误}
end;
test( statbegsys+[ident],declbegsys,7) {测试当前的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,0,dx); { topstack point to operation area } {生成int指令,分配dx个空间}
statement( [semicolon,endsym]+fsys); {调用语法分析程序}
gen(opr,0,0); { return } {生成0号gen程序,完成返回操作}
test( fsys, [],8 ); {测试当前状态是否合法,有问题报8号错误}
listcode; {列出该block所生成的PCODE}
end { block };
procedure interpret; {解释执行程序}
const stacksize = 500; {设置栈大小为常量500}
var p,b,t: integer; { program-,base-,topstack-register } {设置三个寄存器,分别记录下一条指令,基址地址和栈顶指针}
i : instruction;{ instruction register } {指令寄存器,类型为instruction,显然是为了存放当前指令}
s : array[1..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 > 0 do {如果层数大于0,即寻找的不是本层}
begin
b1 := s[b1]; {记录当前层数据基址的内容}
l := l-1 {层数--}
end;
base := b1 {将找到的基地址保存起来}
end; { base }
begin
writeln( 'START PL/0' ); {输出程序开始运行的提示语句}
t := 0; {将栈顶指针置零}
b := 1; {将基址地址置为1}
p := 0; {将指令寄存器置零}
s[1] := 0; {将数据栈的第一层置零,对应SL}
s[2] := 0; {将数据栈的第二层置零,对应DL}
s[3] := 0; {将数据栈的第三层置零,对应RA}
repeat {循环开始}
i := code[p]; {获取当前需要执行的代码}
p := p+1; {将指令寄存器+1,以指向下一条置零}
with i do {针对当前指令}
case f of {不同类型的指令执行不同操作}
lit : begin {对lit类型}
t := t+1; {栈顶指针加1}
s[t]:= a; {将a操作数的值放入栈顶}
end;
opr : case a of { operator } {针对opr类型的指令}
0 : begin { return } {0对应return操作}
t := b-1; {t取到该层数据栈SL-1的位置,意味着将该层的数据栈全部清空(因为要返回了嘛)}
p := s[t+3]; {将指令指针指向RA的值,即获得return address}
b := s[t+2]; {将基址指针指向DL的值,即获得了return之后的基址,因为被调用层次的DL指向调用层次的基址}
end;
1 : s[t] := -s[t]; {1对应取反操作}
2 : begin {2对应求和操作}
t := t-1; {栈顶指针退一格}
s[t] := s[t]+s[t+1] {将栈顶和次栈顶中的数值求和放入新的栈顶,注意运算后的栈顶是下降一格的,下面的运算亦如此}
end;
3 : begin {3对应做差操作}
t := t-1; {栈顶指针退格}
s[t] := s[t]-s[t+1] {次栈顶减栈顶,结果放入新的栈顶}
end;
4 : begin {4对应乘积操作}
t := t-1; {栈顶退格}
s[t] := s[t]*s[t+1] {栈顶和次栈顶相乘,结果放入新的栈顶}
end;
5 : begin {5对应相除}
t := t-1; {栈顶退格}
s[t] := s[t]div s[t+1] {次栈顶除以栈顶,结果放入新的栈顶}
end;
6 : s[t] := ord(odd(s[t])); {6对应判断是否栈顶数值为奇数}
8 : begin {8号对应等值判断}
t := t-1; {栈顶退格}
s[t] := ord(s[t]=s[t+1]) {如果栈顶和次栈顶数值相同,栈顶置一,否则置零}
end;
9 : begin {9号对应不等判断}
t := t-1; {栈顶退格}
s[t] := ord(s[t]<>s[t+1]) {如果栈顶和次栈顶数值不同,栈顶置一,否则置零}
end;
10: begin {10号对应小于判断}
t := t-1; {栈顶退格}
s[t] := ord(s[t]< s[t+1]) {如果次栈顶的数值小于栈顶的数值,栈顶置一,否则置零}
end;
11: begin {11号对应大于等于判断}
t := t-1; {栈顶退格}
s[t] := ord(s[t] >= s[t+1]) {如果次栈顶的数值大于等于栈顶的数值,栈顶置一,否则置零}
end;
12: begin {12号对应着大于判断}
t := t-1; {栈顶退格}
s[t] := ord(s[t] > s[t+1]) {如果次栈顶的数值大于栈顶的数值,栈顶置一,否则置零}
end;
13: begin {13号对应着小于等于判断}
t := t-1; {栈顶退格}
s[t] := ord(s[t] <= s[t+1]) {如果次栈顶的数值小于等于栈顶的数值,栈顶置一,否则置零}
end;
end;
lod : begin {如果是lod指令}
t := t+1; {栈顶指针指向新栈}
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-1 {栈顶退栈}
end;
cal : begin { generate new block mark } {对于指令}
s[t+1] := base(l); {由于要生成新的block,因此栈顶压入SL的值}
s[t+2] := b; {在SL之上压入当前数据区的基址,作为DL}
s[t+3] := p; {在DL之上压入指令指针,即是指令的断点,作为RA}
b := t+1; {把当前的数据区基址指向新的SL}
p := a; {从a的位置继续执行程序,a来自instruction结构体}
end;
int : t := t+a; {对int指令,将栈顶指针上移a个位置}
jmp : p := a; {对jmp指令,将指令指针指向a}
jpc : begin {对于jpc指令}
if s[t] = 0 {如果栈顶数据为零}
then p := a; {则将指令指针指向a}
t := t-1; {栈顶向下移动}
end;
red : begin {对red指令}
writeln('??:'); {输出提示信息}
readln(s[base(l)+a]); {读一行数据,读入到相差l层,层内偏移为a的数据栈中的数据的信息}
end;
wrt : begin {对wrt指令}
writeln(s[t]); {输出栈顶的信息}
t := t+1 {栈顶上移}
end
end { with,case }
until p = 0; {直到当前指令的指针为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[1] := 'begin '; word[2] := 'call ';
word[3] := 'const '; word[4] := 'do ';
word[5] := 'end '; word[6] := 'if ';
word[7] := 'odd '; word[8] := 'procedure ';
word[9] := 'read '; word[10]:= 'then ';
word[11]:= 'var '; word[12]:= 'while ';
word[13]:= 'write '; {填写保留字表,注意这里所有字符都预留的相同的长度}
wsym[1] := beginsym; wsym[2] := callsym;
wsym[3] := constsym; wsym[4] := dosym;
wsym[5] := endsym; wsym[6] := ifsym;
wsym[7] := oddsym; wsym[8] := procsym;
wsym[9] := readsym; wsym[10]:= thensym;
wsym[11]:= varsym; wsym[12]:= whilesym;
wsym[13]:= 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 := 0; {将出错的标识符置零}
cc := 0; {行缓冲指针置零}
cx := 0; {生成代码行数计数置零}
ll := 0; {词法分析行缓冲区长度置零}
ch := ' '; {当前字符设为' '}
kk := al; {kk的值初始化为0}
getsym; {获取第一个词的标识符}
block( 0,0,[period]+declbegsys+statbegsys ); {执行主程序block}
if sym <> period {如果符号不是句号}
then error(9); {报⑨号错误}
if err = 0 {如果err为0表示没有错误}
then interpret {开始解释执行生成的PCODE代码}
else write('ERRORS IN PL/0 PROGRAM'); {否则出现了错误,报错}
writeln; {换行}
close(fin); {关闭源文件程序}
readln(sfile); {读取PL/0源程序}
end.
Pascal-S编译器
比PL0的代码多不少，同样是Pascal的子集，选择重要函数注释，将来有时间的话继续补全
1 program PASCALS(INPUT,OUTPUT,PRD,PRR);
2 { author:N.Wirth, E.T.H. CH-8092 Zurich,1.3.76 }
3 { modified by R.E.Berry
4 Department of computer studies
5 UniversitY of Lancaster
6
7 Variants ot this program are used on
8 Data General Nova,Apple,and
9 Western Digital Microengine machines. }
10 { further modified by M.Z.Jin
11 Department of Computer Science&Engineering BUAA,0ct.1989
12 }
13 { comment by Song Lu
14 Department of Computer Science&Engineering BUAA,Nov.2016
15 }
16 const nkw = 27; { no. of key words } {key word应当理解为保留字}
17 alng = 10; { no. of significant chars in identifiers }
18 llng = 121; { input line length }
19 emax = 322; { max exponent of real numbers }
20 emin = -292; { min exponent }
21 kmax = 15; { max no. of significant digits }
22 tmax = 100; { size of table }
23 bmax = 20; { size of block-talbe }
24 amax = 30; { size of array-table }
25 c2max = 20; { size of real constant table }
26 csmax = 30; { max no. of cases }
27 cmax = 800; { size of code }
28 lmax = 7; { maximum level }
29 smax = 600; { size of string-table }
30 ermax = 58; { max error no. } {最大错误数量}
31 omax = 63; { highest order code }
32 xmax = 32767; { 2**15-1 } {index的范围}
33 nmax = 32767; { 2**15-1 } {数字的范围}
34 lineleng = 132; { output line length }
35 linelimit = 200; {行数限制}
36 stacksize = 1450; {数据栈大小}
37 type symbol = ( intcon, realcon, charcon, stringcon,
38 notsy, plus, minus, times, idiv, rdiv, imod, andsy, orsy,
39 eql, neq, gtr, geq, lss, leq,
40 lparent, rparent, lbrack, rbrack, comma, semicolon, period,
41 colon, becomes, constsy, typesy, varsy, funcsy,
42 procsy, arraysy, recordsy, programsy, ident,
43 beginsy, ifsy, casesy, repeatsy, whilesy, forsy,
44 endsy, elsesy, untilsy, ofsy, dosy, tosy, downtosy, thensy);
45 index = -xmax..+xmax;
46 alfa = packed array[1..alng]of char;
47 objecttyp = (konstant, vvariable, typel, prozedure, funktion );
48 types = (notyp, ints, reals, bools, chars, arrays, records );
49 symset = set of symbol;
50 typset = set of types;
51 item = record
52 typ: types;
53 ref: index;
54 end;
55
56 order = packed record
57 f: -omax..+omax;
58 x: -lmax..+lmax;
59 y: -nmax..+nmax
60 end;
61 var ch: char; { last character read from source program }
62 rnum: real; { real number from insymbol }
63 inum: integer; { integer from insymbol }
64 sleng: integer; { string length }
65 cc: integer; { character counter }
66 lc: integer; { program location counter }
67 ll: integer; { length of current line }
68 errpos: integer;
69 t,a,b,sx,c1,c2:integer; { indices to tables }
70 iflag, oflag, skipflag, stackdump, prtables: boolean;
71 sy: symbol; { last symbol read by insymbol }
72 errs: set of 0..ermax; {记录错误的集合}
73 id: alfa; { identifier from insymbol }
74 progname: alfa;
75 stantyps: typset;
76 constbegsys, typebegsys, blockbegsys, facbegsys, statbegsys: symset;
77 line: array[1..llng] of char;
78 key: array[1..nkw] of alfa; {保留字集合}
79 ksy: array[1..nkw] of symbol; {保留字对应的sym集合}
80 sps: array[char]of symbol; { special symbols }
81 display: array[0..lmax] of integer;
82 tab: array[0..tmax] of { indentifier lable } {符号表}
83 packed record
84 name: alfa;
85 link: index;
86 obj: objecttyp;
87 typ: types;
88 ref: index;
89 normal: boolean;
90 lev: 0..lmax;
91 adr: integer
92 end;
93 atab: array[1..amax] of { array-table } {数组信息向量表}
94 packed record
95 inxtyp,eltyp: types;
96 elref,low,high,elsize,size: index
97 end;
98 btab: array[1..bmax] of { block-table } {分符号表}
99 packed record
100 last, lastpar, psize, vsize: index
101 end;
102 stab: packed array[0..smax] of char; { string table } {字符串常量表}
103 rconst: array[1..c2max] of real; {实常量表}
104 code: array[0..cmax] of order; {P代码表}
105 psin,psout,prr,prd:text; { default in pascal p } {写入inf,outf,fppr文件的文本}
106 inf, outf, fprr: string; {代码输入,代码输出,结果输出的文件路径}
107
108 procedure errormsg; {打印错误信息摘要的过程}
109 var k : integer;
110 msg: array[0..ermax] of alfa; {给定错误信息表,最多ermax种错误}
111 begin
112 msg[0] := 'undef id '; msg[1] := 'multi def '; {给定错误类型'k',及其提示信息}
113 msg[2] := 'identifier'; msg[3] := 'program ';
114 msg[4] := ') '; msg[5] := ': ';
115 msg[6] := 'syntax '; msg[7] := 'ident,var ';
116 msg[8] := 'of '; msg[9] := '( ';
117 msg[10] := 'id,array '; msg[11] := '( ';
118 msg[12] := '] '; msg[13] := '.. ';
119 msg[14] := '; '; msg[15] := 'func. type';
120 msg[16] := '= '; msg[17] := 'boolean ';
121 msg[18] := 'convar typ'; msg[19] := 'type ';
122 msg[20] := 'prog.param'; msg[21] := 'too big ';
123 msg[22] := '. '; msg[23] := 'type(case)';
124 msg[24] := 'character '; msg[25] := 'const id ';
125 msg[26] := 'index type'; msg[27] := 'indexbound';
126 msg[28] := 'no array '; msg[29] := 'type id ';
127 msg[30] := 'undef type'; msg[31] := 'no record ';
128 msg[32] := 'boole type'; msg[33] := 'arith type';
129 msg[34] := 'integer '; msg[35] := 'types ';
130 msg[36] := 'param type'; msg[37] := 'variab id ';
131 msg[38] := 'string '; msg[39] := 'no.of pars';
132 msg[40] := 'real numbr'; msg[41] := 'type ';
133 msg[42] := 'real type '; msg[43] := 'integer ';
134 msg[44] := 'var,const '; msg[45] := 'var,proc ';
135 msg[46] := 'types(:=) '; msg[47] := 'typ(case) ';
136 msg[48] := 'type '; msg[49] := 'store ovfl';
137 msg[50] := 'constant '; msg[51] := ':= ';
138 msg[52] := 'then '; msg[53] := 'until ';
139 msg[54] := 'do '; msg[55] := 'to downto ';
140 msg[56] := 'begin '; msg[57] := 'end ';
141 msg[58] := 'factor';
142
143 writeln(psout); {向文件中打印一个空行}
144 writeln(psout,'key words'); {向psout文件中输出'key words',并换行}
145 k := 0;
146 while errs <> [] do {如果还有错误信息没有处理}
147 begin
148 while not( k in errs )do k := k + 1; {如果不存在第k种错误,则判断是否存在地k+1中}
149 writeln(psout, k, ' ', msg[k] ); {在文件中输出错误的编号及其信息}
150 errs := errs - [k] {将错误集合中的该类错误去除(因为已经处理过)}
151 end { while errs } {循环直到所有错误被处理}
152 end { errormsg } ;
153
154 procedure endskip; {源程序出错后再整个跳过部分代码下面画下划线}
155 begin { underline skipped part of input }
156 while errpos < cc do
157 begin
158 write( psout, '-');
159 errpos := errpos + 1
160 end;
161 skipflag := false
162 end { endskip };
163
164
165 procedure nextch; { read next character; process line end }
166 begin
167 if cc = ll {如果读到了一行的末尾}
168 then begin
169 if eof( psin ) {文件读完了}
170 then begin
171 writeln( psout ); {写输出文件}
172 writeln( psout, 'program incomplete' ); {提示信息}
173 errormsg; {输出错误提示信息到list文件}
174 exit;
175 end;
176 if errpos <> 0 {说明有错误,开始错误处理}
177 then begin
178 if skipflag then endskip; {跳过错误代码}
179 writeln( psout );
180 errpos := 0
181 end;
182 write( psout, lc: 5, ' '); {没有错误执行的操作,在list文件中输出当前PCODE的行数以及一个空格,不换行}
183 ll := 0; {将行长度和行指针置零}
184 cc := 0;
185 while not eoln( psin ) do {如果文件没有读完,读下一行}
186 begin
187 ll := ll + 1; {统计行的长度}
188 read( psin, ch ); {读取下一个字符}
189 write( psout, ch ); {输出到list文件中}
190 line[ll] := ch {将ch保存到line中,循环结束line保存下一行代码的所有信息}
191 end;
192 ll := ll + 1;
193 readln( psin );
194 line[ll] := ' '; {一行的末尾置为空格}
195 writeln( psout );
196 end;
197 cc := cc + 1; {行指针前移}
198 ch := line[cc]; {取词}
199 end { nextch };
200
201 procedure error( n: integer ); {打印出错位置和出错编号}
202 begin
203 if errpos = 0
204 then write ( psout, '****' );
205 if cc > errpos
206 then begin
207 write( psout, ' ': cc-errpos, '^', n:2);
208 errpos := cc + 3;
209 errs := errs +[n]
210 end
211 end { error };
212
213 procedure fatal( n: integer ); {打印表格溢出信息,写入数据多于表大小时会终止程序}
214 var msg : array[1..7] of alfa;
215 begin
216 writeln( psout );
217 errormsg;
218 msg[1] := 'identifier'; msg[2] := 'procedures';
219 msg[3] := 'reals '; msg[4] := 'arrays ';
220 msg[5] := 'levels '; msg[6] := 'code ';
221 msg[7] := 'strings ';
222 writeln( psout, 'compiler table for ', msg[n], ' is too small');
223 exit; {terminate compilation }
224 end { fatal };
225
226 procedure insymbol; {reads next symbol} {取符号方法}
227 label 1,2,3; {定义label,为goto的使用做准备}
228 var i,j,k,e: integer;
229 procedure readscale; {处理实数的指数部分}
230 var s,sign: integer;
231 begin
232 nextch;
233 sign := 1; {符号}
234 s := 0; {数字}
235 if ch = '+' {如果读到'+',不作处理}
236 then nextch
237 else if ch = '-' {如果是'-',符号设为负}
238 then begin
239 nextch;
240 sign := -1
241 end;
242 if not(( ch >= '0' )and (ch <= '9' )) {如果符号后面跟的不是数字,报错}
243 then error( 40 )
244 else repeat
245 s := 10*s + ord( ord(ch)-ord('0')); {把数字存到s中}
246 nextch;
247 until not(( ch >= '0' ) and ( ch <= '9' ));
248 e := s*sign + e {和下面计算中的e结合得到真的e}
249 end { readscale };
250
251 procedure adjustscale; {根据小数位数和指数大小求出数字数值的大小}
252 var s : integer;
253 d, t : real;
254 begin
255 if k + e > emax {当前的位数加上指数如果超上限报错}
256 then error(21)
257 else if k + e < emin {小于最小值}
258 then rnum := 0 {精度不够了,直接记为零}
259 else begin
260 s := abs(e);
261 t := 1.0;
262 d := 10.0;
263 repeat
264 while not odd(s) do {把偶次幂先用平方处理完}
265 begin
266 s := s div 2;
267 d := sqr(d) {sqr表示平方}
268 end;
269 s := s - 1;
270 t := d * t {在乘一下自己,完成1次,即将e分解为2N+1或2N的形式}
271 until s = 0; {t此时为10的e次方}
272 if e >= 0
273 then rnum := rnum * t {e大于零就乘10的e次方}
274 else rnum := rnum / t {反之除}
275 end
276 end { adjustscale };
277
278 procedure options; {编译选项}
279 procedure switch( var b: boolean ); {处理编译选项中的'+''-'号}
280 begin
281 b := ch = '+'; {判断当前符号是否为'+'并存入b中返回,注意pascal中变量形参传的是地址}
282 if not b {如果不是加号}
283 then if not( ch = '-' ) {如果也不是减号}
284 then begin { print error message } {输出错误信息}
285 while( ch <> '*' ) and ( ch <> ',' ) do {跳过无用符号}
286 nextch;
287 end
288 else nextch
289 else nextch
290 end { switch };
291 begin { options } {处理编译选项}
292 repeat
293 nextch;
294 if ch <> '*' {编译选项为*$t+,s+*的形式}
295 then begin
296 if ch = 't' {字母t表示与打印相关的操作}
297 then begin
298 nextch;
299 switch( prtables ) {根据符号判断是否打印表格}
300 end
301 else if ch = 's' {s表示卸出打印}
302 then begin
303 nextch;
304 switch( stackdump )
305 end;
306 end
307 until ch <> ','
308 end { options };
309 begin { insymbol }
310 1: while( ch = ' ' ) or ( ch = chr(9) ) do {第一个flag立起来了! chr可以获得9号字符,即跳过所有的空格和\t}
311 nextch; { space & htab }
312 case ch of
313 'a','b','c','d','e','f','g','h','i',
314 'j','k','l','m','n','o','p','q','r',
315 's','t','u','v','w','x','y','z':
316 begin { identifier of wordsymbol } {如果是字母,开始识别单词}
317 k := 0;
318 id := ' ';
319 repeat
320 if k < alng {alng是限定的关键词长度}
321 then begin
322 k := k + 1;
323 id[k] := ch
324 end;
325 nextch
326 until not((( ch >= 'a' ) and ( ch <= 'z' )) or (( ch >= '0') and (ch <= '9' )));
327 i := 1;
328 j := nkw; { binary search } {二分查表,找到当前id在表中的位置}
329 repeat
330 k := ( i + j ) div 2;
331 if id <= key[k]
332 then j := k - 1;
333 if id >= key[k]
334 then i := k + 1;
335 until i > j;
336 if i - 1 > j
337 then sy := ksy[k] {获取当前ID对应的sym}
338 else sy := ident {没有找到即为标识符}
339 end;
340 '0','1','2','3','4','5','6','7','8','9': {数字开始当做数字识别}
341 begin { number }
342 k := 0;
343 inum := 0;
344 sy := intcon; {sy设为intcon表示数字}
345 repeat
346 inum := inum * 10 + ord(ch) - ord('0'); {把整数部分读完,存到inum}
347 k := k + 1; {k统计当前数字位数}
348 nextch
349 until not (( ch >= '0' ) and ( ch <= '9' ));
350 if( k > kmax ) or ( inum > nmax ) {超上限报错}
351 then begin
352 error(21);
353 inum := 0;
354 k := 0
355 end;
356 if ch = '.' {开始读小数}
357 then begin
358 nextch;
359 if ch = '.'
360 then ch := ':'
361 else begin
362 sy := realcon; {sym为实数}
363 rnum := inum; {rnum存实数的值}
364 e := 0; {指数}
365 while ( ch >= '0' ) and ( ch <= '9' ) do {把数字读完}
366 begin
367 e := e - 1;
368 rnum := 10.0 * rnum + (ord(ch) - ord('0')); {暂时当做整数存}
369 nextch
370 end;
371 if e = 0 {小数点后没数字,40号error}
372 then error(40);
373 if ch = 'e' {如果是科学计数法}
374 then readscale; {算e}
375 if e <> 0 then adjustscale {算数,rnum存数}
376 end
377 end
378 else if ch = 'e'
379 then begin
380 sy := realcon;
381 rnum := inum;
382 e := 0;
383 readscale;
384 if e <> 0
385 then adjustscale
386 end;
387 end;
388 ':':
389 begin
390 nextch;
391 if ch = '='
392 then begin
393 sy := becomes;
394 nextch
395 end
396 else sy := colon
397 end;
398 '<':
399 begin
400 nextch;
401 if ch = '='
402 then begin
403 sy := leq;
404 nextch
405 end
406 else
407 if ch = '>'
408 then begin
409 sy := neq;
410 nextch
411 end
412 else sy := lss
413 end;
414 '>':
415 begin
416 nextch;
417 if ch = '='
418 then begin
419 sy := geq;
420 nextch
421 end
422 else sy := gtr
423 end;
424 '.':
425 begin
426 nextch;
427 if ch = '.'
428 then begin
429 sy := colon; {..居然算作colon冒号}
430 nextch
431 end
432 else sy := period
433 end;
434 '''': {当前字符是否单引号}
435 begin
436 k := 0;
437 2: nextch;
438 if ch = ''''
439 then begin
440 nextch;
441 if ch <> ''''
442 then goto 3
443 end;
444 if sx + k = smax
445 then fatal(7);
446 stab[sx+k] := ch;
447 k := k + 1;
448 if cc = 1
449 then begin { end of line }
450 k := 0;
451 end
452 else goto 2;
453 3: if k = 1 {双引号中间只有一个字符}
454 then begin
455 sy := charcon; {sym类型为字符类型}
456 inum := ord( stab[sx] ) {inum存储该字符的ascii码值}
457 end
458 else if k = 0 {空引号,中间没东西}
459 then begin
460 error(38); {报错}
461 sy := charcon; {类型字符常量}
462 inum := 0 {asc为0}
463 end
464 else begin
465 sy := stringcon; {否则就是一个字符串类型}
466 inum := sx;
467 sleng := k;
468 sx := sx + k
469 end
470 end;
471 '(':
472 begin
473 nextch;
474 if ch <> '*'
475 then sy := lparent
476 else begin { comment }
477 nextch;
478 if ch = '$'
479 then options;
480 repeat
481 while ch <> '*' do nextch;
482 nextch
483 until ch = ')';
484 nextch;
485 goto 1
486 end
487 end;
488 '{':
489 begin
490 nextch;
491 if ch = '$' {左括号加$是进行编译选项的设置}
492 then options;
493 while ch <> '}' do
494 nextch;
495 nextch;
496 goto 1
497 end;
498 '+', '-', '*', '/', ')', '=', ',', '[', ']', ';': {操作符直接处理}
499 begin
500 sy := sps[ch];
501 nextch
502 end;
503 '$','"' ,'@', '?', '&', '^', '!': {单独出现算错}
504 begin
505 error(24);
506 nextch;
507 goto 1
508 end
509 end { case }
510 end { insymbol };
511
512 procedure enter(x0:alfa; x1:objecttyp; x2:types; x3:integer ); {将当前符号(分程序外的)录入符号表}
513 begin
514 t := t + 1; { enter standard identifier }
515 with tab[t] do
516 begin
517 name := x0;
518 link := t - 1;
519 obj := x1;
520 typ := x2;
521 ref := 0;
522 normal := true;
523 lev := 0;
524 adr := x3;
525 end
526 end; { enter }
527
528 procedure enterarray( tp: types; l,h: integer ); {将数组信息录入数组表atab}
529 begin
530 if l > h {下界大于上界,错误}
531 then error(27);
532 if( abs(l) > xmax ) or ( abs(h) > xmax )
533 then begin
534 error(27);
535 l := 0;
536 h := 0;
537 end;
538 if a = amax {表满了}
539 then fatal(4)
540 else begin
541 a := a + 1;
542 with atab[a] do
543 begin
544 inxtyp := tp; {下标类型}
545 low := l; {上界和下界}
546 high := h
547 end
548 end
549 end { enterarray };
550
551 procedure enterblock; {将分程序登录到分程序表}
552 begin
553 if b = bmax {表满了}
554 then fatal(2) {报错退出}
555 else begin
556 b := b + 1;
557 btab[b].last := 0; {指向过程或函数最后一个符号在表中的位置,建表用}
558 btab[b].lastpar := 0; {指向过程或者函数的最后一个'参数'符号在tab中的位置,退栈用}
559 end
560 end { enterblock };
561
562 procedure enterreal( x: real ); {登陆实常量表}
563 begin
564 if c2 = c2max - 1
565 then fatal(3)
566 else begin
567 rconst[c2+1] := x;
568 c1 := 1;
569 while rconst[c1] <> x do
570 c1 := c1 + 1;
571 if c1 > c2
572 then c2 := c1
573 end
574 end { enterreal };
575
576 procedure emit( fct: integer ); {emit和下面两个方法都是用来生成PCODE的,后面接的数字是代表有几个操作数}
577 begin
578 if lc = cmax
579 then fatal(6);
580 code[lc].f := fct;
581 lc := lc + 1
582 end { emit };
583
584
585 procedure emit1( fct, b: integer );
586 begin
587 if lc = cmax
588 then fatal(6);
589 with code[lc] do
590 begin
591 f := fct;
592 y := b;
593 end;
594 lc := lc + 1
595 end { emit1 };
596
597 procedure emit2( fct, a, b: integer );
598 begin
599 if lc = cmax then fatal(6);
600 with code[lc] do
601 begin
602 f := fct;
603 x := a;
604 y := b
605 end;
606 lc := lc + 1;
607 end { emit2 };
608
609 procedure printtables; {打印表的过程}
610 var i: integer;
611 o: order;
612 mne: array[0..omax] of
613 packed array[1..5] of char;
614 begin
615 mne[0] := 'LDA '; mne[1] := 'LOD '; mne[2] := 'LDI '; {定义PCODE指令符}
616 mne[3] := 'DIS '; mne[8] := 'FCT '; mne[9] := 'INT ';
617 mne[10] := 'JMP '; mne[11] := 'JPC '; mne[12] := 'SWT ';
618 mne[13] := 'CAS '; mne[14] := 'F1U '; mne[15] := 'F2U ';
619 mne[16] := 'F1D '; mne[17] := 'F2D '; mne[18] := 'MKS ';
620 mne[19] := 'CAL '; mne[20] := 'IDX '; mne[21] := 'IXX ';
621 mne[22] := 'LDB '; mne[23] := 'CPB '; mne[24] := 'LDC ';
622 mne[25] := 'LDR '; mne[26] := 'FLT '; mne[27] := 'RED ';
623 mne[28] := 'WRS '; mne[29] := 'WRW '; mne[30] := 'WRU ';
624 mne[31] := 'HLT '; mne[32] := 'EXP '; mne[33] := 'EXF ';
625 mne[34] := 'LDT '; mne[35] := 'NOT '; mne[36] := 'MUS ';
626 mne[37] := 'WRR '; mne[38] := 'STO '; mne[39] := 'EQR ';
627 mne[40] := 'NER '; mne[41] := 'LSR '; mne[42] := 'LER ';
628 mne[43] := 'GTR '; mne[44] := 'GER '; mne[45] := 'EQL ';
629 mne[46] := 'NEQ '; mne[47] := 'LSS '; mne[48] := 'LEQ ';
630 mne[49] := 'GRT '; mne[50] := 'GEQ '; mne[51] := 'ORR ';
631 mne[52] := 'ADD '; mne[53] := 'SUB '; mne[54] := 'ADR ';
632 mne[55] := 'SUR '; mne[56] := 'AND '; mne[57] := 'MUL ';
633 mne[58] := 'DIV '; mne[59] := 'MOD '; mne[60] := 'MUR ';
634 mne[61] := 'DIR '; mne[62] := 'RDL '; mne[63] := 'WRL ';
635
636 writeln(psout);
637 writeln(psout);
638 writeln(psout);
639 writeln(psout,' identifiers link obj typ ref nrm lev adr');
640 writeln(psout);
641 for i := btab[1].last to t do {}
642 with tab[i] do
643 writeln( psout, i,' ', name, link:5, ord(obj):5, ord(typ):5,ref:5, ord(normal):5,lev:5,adr:5);
644 writeln( psout );
645 writeln( psout );
646 writeln( psout );
647 writeln( psout, 'blocks last lpar psze vsze' );
648 writeln( psout );
649 for i := 1 to b do
650 with btab[i] do
651 writeln( psout, i:4, last:9, lastpar:5, psize:5, vsize:5 );
652 writeln( psout );
653 writeln( psout );
654 writeln( psout );
655 writeln( psout, 'arrays xtyp etyp eref low high elsz size');
656 writeln( psout );
657 for i := 1 to a do
658 with atab[i] do
659 writeln( psout, i:4, ord(inxtyp):9, ord(eltyp):5, elref:5, low:5, high:5, elsize:5, size:5);
660 writeln( psout );
661 writeln( psout );
662 writeln( psout );
663 writeln( psout, 'code:');
664 writeln( psout );
665 for i := 0 to lc-1 do
666 begin
667 write( psout, i:5 );
668 o := code[i];
669 write( psout, mne[o.f]:8, o.f:5 );
670 if o.f < 31
671 then if o.f < 4
672 then write( psout, o.x:5, o.y:5 )
673 else write( psout, o.y:10 )
674 else write( psout, ' ' );
675 writeln( psout, ',' )
676 end;
677 writeln( psout );
678 writeln( psout, 'Starting address is ', tab[btab[1].last].adr:5 )
679 end { printtables };
680
681
682 procedure block( fsys: symset; isfun: boolean; level: integer ); {程序分析过程}
683 type conrec = record {这种结构体可以根据不同的type类型来保存不同样式的数据}
684 case tp: types of
685 ints, chars, bools : ( i:integer );
686 reals :( r:real )
687 end;
688 var dx : integer ; { data allocation index }
689 prt: integer ; { t-index of this procedure }
690 prb: integer ; { b-index of this procedure }
691 x : integer ;
692
693
694 procedure skip( fsys:symset; n:integer); {跳过错误的代码段}
695 begin
696 error(n);
697 skipflag := true;
698 while not ( sy in fsys ) do
699 insymbol;
700 if skipflag then endskip
701 end { skip };
702
703 procedure test( s1,s2: symset; n:integer ); {检查当前sym是否合法}
704 begin
705 if not( sy in s1 )
706 then skip( s1 + s2, n )
707 end { test };
708
709 procedure testsemicolon; {检查分号是否合法}
710 begin
711 if sy = semicolon
712 then insymbol
713 else begin
714 error(14);
715 if sy in [comma, colon]
716 then insymbol
717 end;
718 test( [ident] + blockbegsys, fsys, 6 )
719 end { testsemicolon };
720
721
722 procedure enter( id: alfa; k:objecttyp ); {将分程序中的某一符号入符号表}
723 var j,l : integer;
724 begin
725 if t = tmax {表满了报错退出}
726 then fatal(1)
727 else begin
728 tab[0].name := id;
729 j := btab[display[level]].last; {获取指向当前层最后一个标识符在tab表中的位置}
730 l := j;
731 while tab[j].name <> id do
732 j := tab[j].link;
733 if j <> 0 {j不等于0说明此符号已经在符号表中出现过,报1号错误,意味着重复定义了}
734 then error(1)
735 else begin {没重复定义就正常入栈}
736 t := t + 1;
737 with tab[t] do {将符号放入符号表,注意这里并没有给定符号的typ,ref和adr,这三个变量在procedure typ中被处理}
738 begin
739 name := id; {输入参数之一,符号的名字}
740 link := l;
741 obj := k; {输入参数之一,符号代表的目标种类(大类)}
742 typ := notyp;
743 ref := 0;
744 lev := level;
745 adr := 0;
746 normal := false { initial value }
747 end;
748 btab[display[level]].last := t {更新当前层最后一个标识符}
749 end
750 end
751 end { enter };
752
753 function loc( id: alfa ):integer; {查找id在符号表中的位置}
754 var i,j : integer; { locate if in table }
755 begin
756 i := level;
757 tab[0].name := id; { sentinel }
758 repeat
759 j := btab[display[i]].last;
760 while tab[j].name <> id do
761 j := tab[j].link;
762 i := i - 1;
763 until ( i < 0 ) or ( j <> 0 );
764 if j = 0 {符号没找到,说明之前没声明,报0号错误}
765 then error(0);
766 loc := j
767 end { loc } ;
768
769 procedure entervariable; {变量登陆符号表的过程}
770 begin
771 if sy = ident
772 then begin
773 enter( id, vvariable );
774 insymbol
775 end
776 else error(2)
777 end { entervariable };
778
779 procedure constant( fsys: symset; var c: conrec ); {处理程序中出现的常量,变量c负责返回该常量的类型和值}
780 var x, sign : integer;
781 begin
782 c.tp := notyp;
783 c.i := 0;
784 test( constbegsys, fsys, 50 );
785 if sy in constbegsys {如果第一个sym是常量开始的符号,才往下继续分析}
786 then begin {根据不同的符号执行不同的操作,目的就是返回正确的c}
787 if sy = charcon {对字符常量}
788 then begin
789 c.tp := chars; {类型是char}
790 c.i := inum; {inum存储该字符的ascii码值}
791 insymbol {获取下一个sym}
792 end
793 else begin
794 sign := 1; {不是符号常量}
795 if sy in [plus, minus]
796 then begin
797 if sy = minus
798 then sign := -1; {负号变符号}
799 insymbol
800 end;
801 if sy = ident {遇到了标识符}
802 then begin
803 x := loc(id); {找到当前id在表中的位置}
804 if x <> 0 {找到了}
805 then
806 if tab[x].obj <> konstant {如果id对应的符号种类不是常量,报错}
807 then error(25)
808 else begin
809 c.tp := tab[x].typ; {获得常量类型}
810 if c.tp = reals {对实数和整数采取不同的赋值方法}
811 then c.r := sign*rconst[tab[x].adr]
812 else c.i := sign*tab[x].adr
813 end;
814 insymbol
815 end
816 else if sy = intcon {遇到整数}
817 then begin
818 c.tp := ints; {存type存值}
819 c.i := sign*inum;
820 insymbol
821 end
822 else if sy = realcon {遇到实数}
823 then begin
824 c.tp := reals;
825 c.r := sign*rnum;
826 insymbol
827 end
828 else skip(fsys,50) {跳过无用符号}
829 end;
830 test(fsys,[],6)
831 end
832 end { constant };
833
834 procedure typ( fsys: symset; var tp: types; var rf,sz:integer ); {处理类型说明,返回当前关键词的类型,在符号表中的位置,以及需要占用存储空间的大小}
835 var eltp : types; {元素类型}
836 elrf, x : integer;
837 elsz, offset, t0, t1 : integer;
838
839 procedure arraytyp( var aref, arsz: integer ); {处理数组类型的子过程}
840 var eltp : types; {记录元素的类型,pascal中一个数组的所有元素的类型必须相同}
841 low, high : conrec; {记录数组编号(index)的上下界}
842 elrf, elsz: integer; {记录ref和size方便返回}
843 begin
844 constant( [colon, rbrack, rparent, ofsy] + fsys, low ); {获得数组编号的下界}
845 if low.tp = reals {如果下界类型为实型}
846 then begin
847 error(27); {报27号错误}
848 low.tp := ints; {类型为整型}
849 low.i := 0 {数值设为0}
850 end;
851 if sy = colon {下界后面跟'..',类型是colon,constant结束后读入了下一个sym}
852 then insymbol {获得下一个sym}
853 else error(13); {如果后面跟的不是..,报13号错误}
854 constant( [rbrack, comma, rparent, ofsy ] + fsys, high ); {获取数组下表上界}
855 if high.tp <> low.tp {上下界类型不同报错,也就是说上界也必须是整型}
856 then begin
857 error(27); {报27号错误}
858 high.i := low.i {容错,是使得上界等于下界}
859 end;
860 enterarray( low.tp, low.i, high.i ); {将数组的信息录入到atab中}
861 aref := a; {获取当前数组在atab中的位置}
862 if sy = comma {后面接逗号,说明需要建立多维数组}
863 then begin
864 insymbol; {读取下一个字符}
865 eltp := arrays; {数组中的每个元素类型都是数组}
866 arraytyp( elrf, elsz ) {递归调用arraytyp处理数组元素}
867 end
868 else begin
869 if sy = rbrack {遇到右中括号,则index部分声明完毕}
870 then insymbol {获取下一个sym}
871 else begin
872 error(12); {缺少右中括号}
873 if sy = rparent {如果是右括号}
874 then insymbol {容错}
875 end;
876 if sy = ofsy {获取到了of关键字}
877 then insymbol {获取下一个sym}
878 else error(8); {没有of报8号错}
879 typ( fsys, eltp, elrf, elsz ) {处理当前的符号类型}
880 end;
881 with atab[aref] do {记录当前数组的信息}
882 begin
883 arsz := (high-low+1) * elsz; {计算该数组需要占用的存储空间}
884 size := arsz; {记录该数组需要占用的存储空间}
885 eltyp := eltp; {记录数组的元素类型}
886 elref := elrf; {记录数组在atab中登陆的位置}
887 elsize := elsz {记录每个元素的大小}
888 end
889 end { arraytyp };
890 begin { typ } {类型处理过程开始}
891 tp := notyp; {用以存储变量的类型}
892 rf := 0; {用以记录符号在符号表中的位置}
893 sz := 0; {用以储存该类型的大小}
894 test( typebegsys, fsys, 10 ); {测试当前符号是否是数组声明的开始符号,如果不是则报10号错误}
895 if sy in typebegsys {如果是数组声明的开始符号}
896 then begin
897 if sy = ident {如果现在的符号是标识符}
898 then begin
899 x := loc(id); {查找id在符号表中的位置}
900 if x <> 0 {如果找到了}
901 then with tab[x] do {对其对应表项进行操作}
902 if obj <> typel {标识符的种类不是'种类'(typel)}
903 then error(29) {报29号错,因为声明一个变量需要先标明其类型}
904 else begin
905 tp := typ; {获得其代表的类型(char,int,real..)}
906 rf := ref; {获得其在符号表中的位置}
907 sz := adr; {获得其在运行栈中分配的储存单元的相对地址}
908 if tp = notyp {如果未定义类型}
909 then error(30) {报30号错}
910 end;
911 insymbol {获得下一个sym}
912 end
913 else if sy = arraysy {如果遇到的是数组元素,即声明开头为'array'}
914 then begin
915 insymbol; {获得下一个sym}
916 if sy = lbrack {数组元素声明应该从左中括号开始,即表明数组的大小/维度}
917 then insymbol {获取下一个sym}
918 else begin {如果不是左中括号开始}
919 error(11); {报11号错误,说明左括号发生错误}
920 if sy = lparent {如果找到了左括号,可能是用户输入错误,报错后做容错处理}
921 then insymbol {获取下一个sym}
922 end;
923 tp := arrays; {当前类型设置为数组类型}
924 arraytyp(rf,sz) {获得数组在atab表中的登陆位置,和数组的大小}
925 end
926 else begin { records } {否则一定是record的类型,因为typebegsys中只包含ident,arraysy和recordsy三种类型}
927 insymbol; {获取下一个sym}
928 enterblock; {登陆子程序}
929 tp := records; {当前类型设置为records类型}
930 rf := b; {rf指向当前过程在block表中的位置}
931 if level = lmax {如果当前嵌套层次已经是最大层次了,即不能产生更深的嵌套}
932 then fatal(5); {报5号严重错误并终止程序}
933 level := level + 1; {如果还能嵌套,声明程序成功,block的层次是当前层次+1}
934 display[level] := b; {设置当前层次的display区.建立分层次索引}
935 offset := 0;
936 while not ( sy in fsys - [semicolon,comma,ident]+ [endsy] ) do {end之前都是记录类型变量内的变量声明}
937 begin { field section } {开始处理record内部的成员变量}
938 if sy = ident {如果遇到的是标识符}
939 then begin
940 t0 := t; {获得当前tab指针的位置}
941 entervariable; {变量入表}
942 while sy = comma do {同种变量之间通过逗号分隔,未遇到分号则继续读入}
943 begin
944 insymbol; {获得下一个sym}
945 entervariable {继续变量入表的过程}
946 end;
947 if sy = colon {遇到了冒号,说明这类的变量声明结束了,冒号后面跟变量的类型}
948 then insymbol {获取sym}
949 else error(5); {如果没有遇到逗号或者冒号,则抛出5号错误}
950 t1 := t; {记录当前tab栈顶符号的位置,至此t0到t1的符号表中并没有填写typ,ref和adr}
951 typ( fsys + [semicolon, endsy, comma,ident], eltp, elrf,elsz ); {递归调用typ来处理记录类型的成员变量,确定各成员的类型,ref和adr(注意对于不同的类型,ref和adr可能表示不同的意义)}
952 while t0 < t1 do {填写t0到t1中信息缺失的部分,需要注意的是t0~t1都是同一类型的变量,因此size大小是相同的}
953 begin
954 t0 := t0 + 1; {指针上移}
955 with tab[t0] do {修改当前表项}
956 begin
957 typ := eltp; {给typ赋值,eltp来之上面递归调用的typ语句}
958 ref := elrf; {给ref赋值}
959 normal := true; {给normal标记赋值,所有normal的初值都是false}
960 adr := offset; {记录该变量相对于起始地址的位移}
961 offset := offset + elsz {获得下一变量的其实地址}
962 end
963 end
964 end; { sy = ident }
965 if sy <> endsy {遇到end说明成员声明已经结束了}
966 then begin
967 if sy = semicolon {end后面需要接分号}
968 then insymbol {获取下一个sym}
969 else begin {如果接的不是分号}
970 error(14); {先报个错}
971 if sy = comma {如果是逗号做容错处理}
972 then insymbol {然后获取下一个sym类型}
973 end;
974 test( [ident,endsy, semicolon],fsys,6 ) {检验当前符号是否合法}
975 end
976 end; { field section }
977 btab[rf].vsize := offset; {offset存储了当前的局部变量,参数以及display区所占的空间总数,将其记录下来}
978 sz := offset; {储存其占用空间总数}
979 btab[rf].psize := 0; {该程序块的参数占用空间设为0,因为record类型并不是真正的过程变量,没有参数}
980 insymbol; {后去下一个sym}
981 level := level - 1 {record声明结束后退出当前层次}
982 end; { record }
983 test( fsys, [],6 ) {检查当前sym是否合法}
984 end;
985 end { typ };
986
987 procedure parameterlist; { formal parameter list } {处理过程或函数说明中的形参,将形参登陆到符号表}
988 var tp : types; {记录类型}
989 valpar : boolean; {记录当前参数是否为值形参(valueparameter)}
990 rf, sz, x, t0 : integer;
991 begin
992 insymbol; {获得下一个sym}
993 tp := notyp; {初始化类型}
994 rf := 0; {初始化符号表位置}
995 sz := 0; {初始化元素大小}
996 test( [ident, varsy], fsys+[rparent], 7 ); {检验当前符号是否合法}
997 while sy in [ident, varsy] do {如果当前的符号是标识符或者var关键字}
998 begin
999 if sy <> varsy {如果是var关键字}
1000 then valpar := true {将valpar标识符设置为真}
1001 else begin
1002 insymbol; {如果不是标识符,获取下一个sym}
1003 valpar := false {将valpar设置为假}
1004 end;
1005 t0 := t; {记录当前符号表栈顶位置}
1006 entervariable; {调用变量入表的子过程,将参数符号放入符号表}
1007 while sy = comma do {如果识别到逗号,说明还有同类型的参数,继续放入符号表}
1008 begin
1009 insymbol; {获取下一个sym}
1010 entervariable; {将当前sym放入符号表}
1011 end;
1012 if sy = colon {如果识别到冒号,开始处理类型}
1013 then begin
1014 insymbol; {获取下一个sym,这里应当是类型}
1015 if sy <> ident {如果不是标识符}
1016 then error(2) {报2号错误}
1017 else begin
1018 x := loc(id); {如果是标识符,则寻找其在符号表中的位置}
1019 insymbol; {获取下一个sym}
1020 if x <> 0 {如果在符号表中找到了sym}
1021 then with tab[x] do {对当前表项做操作}
1022 if obj <> typel {如果当前的符号不是类型标识符}
1023 then error(29) {报29号错误}
1024 else begin
1025 tp := typ; {获取参数的类型}
1026 rf := ref; {获取参数在当前符号表的位置}
1027 if valpar {如果是值形参}
1028 then sz := adr {sz获得当前形参在符号表中的位置}
1029 else sz := 1 {否则将sz置为1}
1030 end;
1031 end;
1032 test( [semicolon, rparent], [comma,ident]+fsys, 14 ) {检验当前符号是否合法,不合法报14号错误}
1033 end
1034 else error(5); {如果不是分号,报5号错误}
1035 while t0 < t do {t0~t都是同一类型将上面处理的符号中的属性填写完整}
1036 begin
1037 t0 := t0 + 1; {获得刚才读到的第一个参数}
1038 with tab[t0] do {对当前符号表中的符号做操作}
1039 begin
1040 typ := tp; {设置当前符号的类型}
1041 ref := rf; {设置当前符号在符号表中的位置}
1042 adr := dx; {设置形参的相对地址}
1043 lev := level; {设置形参的level}
1044 normal := valpar; {设置当前变量的normal标记}
1045 dx := dx + sz {更新位移量}
1046 end
1047 end;
1048 if sy <> rparent {如果声明结束之后不是右括号}
1049 then begin
1050 if sy = semicolon {而是分号,说明还有需要声明的参数}
1051 then insymbol {获取下一个sym}
1052 else begin
1053 error(14); {否则报14号错误}
1054 if sy = comma {如果是逗号,做容错处理}
1055 then insymbol {接受下一个sym}
1056 end;
1057 test( [ident, varsy],[rparent]+fsys,6) {检查下面的符号是否是标识符或者变量声明,均不是则报6号错误}
1058 end
1059 end { while };
1060 if sy = rparent {参数声明结束后应当用右括号结尾}
1061 then begin
1062 insymbol; {获取下一个符号}
1063 test( [semicolon, colon],fsys,6 ) {声明结束后用分号结束或使用冒号声明返回值类型,如果不是这两种符号,报6号错误}
1064 end
1065 else error(4) {不是右括号结尾,报错}
1066 end { parameterlist };
1067
1068
1069 procedure constdec; {常量声明的处理过程}
1070 var c : conrec;
1071 begin
1072 insymbol; {获取下一个sym}
1073 test([ident], blockbegsys, 2 ); {检查是不是标识符}
1074 while sy = ident do {当获得的是标志符的是否做循环}
1075 begin
1076 enter(id, konstant); {入表,类型为konstant表示常量}
1077 insymbol;
1078 if sy = eql {等号}
1079 then insymbol
1080 else begin
1081 error(16);
1082 if sy = becomes {赋值符号容错}
1083 then insymbol
1084 end;
1085 constant([semicolon,comma,ident]+fsys,c); {获得常量的类型和数值}
1086 tab[t].typ := c.tp; {填表}
1087 tab[t].ref := 0; {常量ref为0}
1088 if c.tp = reals
1089 then begin {实型和整型的操作不同}
1090 enterreal(c.r);
1091 tab[t].adr := c1; {实常量的adr保存了其在rconst表中的登陆的位置}
1092 end
1093 else tab[t].adr := c.i;
1094 testsemicolon
1095 end
1096 end { constdec };
1097
1098 procedure typedeclaration; {处理类型声明}
1099 var tp: types;
1100 rf, sz, t1 : integer;
1101 begin
1102 insymbol;
1103 test([ident], blockbegsys,2 ); {检查获取到的是不是标识符}
1104 while sy = ident do {对于是标识符的情况进行操作}
1105 begin
1106 enter(id, typel); {类型的名称的类型入表}
1107 t1 := t; {获得符号表顶部指针}
1108 insymbol;
1109 if sy = eql {获取等号}
1110 then insymbol
1111 else begin
1112 error(16);
1113 if sy = becomes {赋值符号容错}
1114 then insymbol
1115 end;
1116 typ( [semicolon,comma,ident]+fsys, tp,rf,sz ); {获得类型变量的类型,在符号表中的位置以及占用空间的大小}
1117 with tab[t1] do {将返回值填表}
1118 begin
1119 typ := tp;
1120 ref := rf;
1121 adr := sz
1122 end;
1123 testsemicolon
1124 end
1125 end { typedeclaration };
1126
1127 procedure variabledeclaration; {处理变量声明}
1128 var tp : types;
1129 t0, t1, rf, sz : integer;
1130 begin
1131 insymbol;
1132 while sy = ident do
1133 begin
1134 t0 := t;
1135 entervariable;
1136 while sy = comma do
1137 begin
1138 insymbol;
1139 entervariable; {调用变量入表的程序}
1140 end;
1141 if sy = colon
1142 then insymbol
1143 else error(5);
1144 t1 := t;
1145 typ([semicolon,comma,ident]+fsys, tp,rf,sz ); {获得类型,地址和大小}
1146 while t0 < t1 do
1147 begin
1148 t0 := t0 + 1;
1149 with tab[t0] do {填表}
1150 begin
1151 typ := tp;
1152 ref := rf;
1153 lev := level;
1154 adr := dx;
1155 normal := true;
1156 dx := dx + sz
1157 end
1158 end;
1159 testsemicolon
1160 end
1161 end { variabledeclaration };
1162
1163 procedure procdeclaration; {处理过程声明}
1164 var isfun : boolean;
1165 begin
1166 isfun := sy = funcsy;
1167 insymbol;
1168 if sy <> ident
1169 then begin
1170 error(2);
1171 id :=' '
1172 end;
1173 if isfun {函数和过程使用不同的kind类型}
1174 then enter(id,funktion)
1175 else enter(id,prozedure);
1176 tab[t].normal := true;
1177 insymbol;
1178 block([semicolon]+fsys, isfun, level+1 ); {过程的处理直接调用block}
1179 if sy = semicolon
1180 then insymbol
1181 else error(14);
1182 emit(32+ord(isfun)) {exit} {推出过程/函数}
1183 end { proceduredeclaration };
1184
1185
1186 procedure statement( fsys:symset );
1187 var i : integer;
1188
1189 procedure expression(fsys:symset; var x:item); forward; {处理表达式的子程序,由x返回结果,forward使得selector可以调用expression}
1190 procedure selector(fsys:symset; var v:item); {处理结构变量:数组下标或记录成员变量}
1191 var x : item;
1192 a,j : integer;
1193 begin { sy in [lparent, lbrack, period] } {当前的符号应该是左括号,做分号或句号之一}
1194 repeat
1195 if sy = period {如果当前的符号是句号,因为引用成员变量的方式为'记录名.成员名',因此识别到'.'之后应该开始处理后面的结构名称}
1196 then begin
1197 insymbol; { field selector } {处理成员变量}
1198 if sy <> ident {如果获取到的不是标识符}
1199 then error(2) {报2号错误}
1200 else begin
1201 if v.typ <> records {如果处理的不是记录类型}
1202 then error(31) {报31号错误}
1203 else begin { search field identifier } {在符号表中寻找类型标识符}
1204 j := btab[v.ref].last; {获得该结构体在符号表中最后一个符号的位置}
1205 tab[0].name := id; {暂存当前符号的id}
1206 while tab[j].name <> id do {在符号表中寻找当前符号}
1207 j := tab[j].link; {没对应上则继续向前找}
1208 if j = 0 {在当前层(记录中)没找到对应的符号,符号未声明}
1209 then error(0); {报0号错误}
1210 v.typ := tab[j].typ; {找到了则获取属性}
1211 v.ref := tab[j].ref; {记录其所在的btab位置}
1212 a := tab[j].adr; {记录该成员变量相对于记录变量起始地址的位移}
1213 if a <> 0 {如果位移不为零}
1214 then emit1(9,a) {生成一条指令来计算此位移}
1215 end;
1216 insymbol {获取下一个sym}
1217 end
1218 end
1219 else begin { array selector } {处理数组下表}
1220 if sy <> lbrack {如果下表不是左括号开头}
1221 then error(11); {报11号错误}
1222 repeat {循环,针对多维数组}
1223 insymbol; {获取下一个sym}
1224 expression( fsys+[comma,rbrack],x); {递归调用处理表达式的过程处理数组下标,获得返回结果保存到x中}
1225 if v.typ <> arrays {如果传入的类型不是数组}
1226 then error(28) {报22号错误}
1227 else begin
1228 a := v.ref; {获得该数组在atab中的位置}
1229 if atab[a].inxtyp <> x.typ {如果传入的下标和数组规定的下标类型不符}
1230 then error(26) {报26号错误}
1231 else if atab[a].elsize = 1 {如果是变量形参}
1232 then emit1(20,a) {进行寻址操作}
1233 else emit1(21,a); {对值形参也进行寻址操作}
1234 v.typ := atab[a].eltyp; {获得当前数组元素的类型}
1235 v.ref := atab[a].elref {获得数组元素在atab中的位置}
1236 end
1237 until sy <> comma; {如果读到的不是逗号,说明没有更高维的数组}
1238 if sy = rbrack {如果读到右中括号}
1239 then insymbol {读取下一个sym}
1240 else begin
1241 error(12); {没读到右中括号则报12号错误}
1242 if sy = rparent {如果读到了右括号,做容错处理}
1243 then insymbol {读取下一个sym}
1244 end
1245 end
1246 until not( sy in[lbrack, lparent, period]); {循环直到所有子结构(数组下标或者记录)都被识别完位置}
1247 test( fsys,[],6) {检测当前的符号是否合法}
1248 end { selector };
1249
1250 procedure call( fsys: symset; i:integer ); {处理非标准过程和函数调用的方法,其中i表示需要调用的过程或函数名在符号表中的位置}
1251 var x : item;
1252 lastp,cp,k : integer;
1253 begin
1254 emit1(18,i); { mark stack } {生成标记栈指令,传入被调用过程或函数在tab表中的位置,建立新的内务信息区}
1255 lastp := btab[tab[i].ref].lastpar; {记录当前过程或函数最后一个参数在符号表中的位置}
1256 cp := i; {记录被调用过程在符号表中的位置}
1257 if sy = lparent {如果是识别到左括号}
1258 then begin { actual parameter list } {开始处理参数}
1259 repeat {开始循环}
1260 insymbol; {获取参数的sym}
1261 if cp >= lastp {如果当前符号的位置小于最后一个符号的位置,说明还有参数没有处理,反之是错误的}
1262 then error(39) {报39号错误}
1263 else begin {开始处理参数}
1264 cp := cp + 1; {将cp指针向上移动一格}
1265 if tab[cp].normal {如果normal的值为真,即如果传入的是值形参或者其他参数}
1266 then begin { value parameter } {开始处理值形参}
1267 expression( fsys+[comma, colon,rparent],x); {递归调用处理表达式的过程处理参数}
1268 if x.typ = tab[cp].typ {如果参数的类型和符号表中规定的类型相同}
1269 then begin
1270 if x.ref <> tab[cp].ref {如果表达式指向的btab和符号表中所记录的btab不同}
1271 then error(36) {报36号错误}
1272 else if x.typ = arrays {如果遇到了数组类型}
1273 then emit1(22,atab[x.ref].size) {生成装入块指令,将实参表达式的值或地址放到预留的参数单元中}
1274 else if x.typ = records {如果遇到了记录类型}
1275 then emit1(22,btab[x.ref].vsize) {同样生成装入块指令完成操作,只是细节有所不同}
1276 end
1277 else if ( x.typ = ints ) and ( tab[cp].typ = reals ) {如果表达式的类型是整型,但是要求是输入的是实型参数}
1278 then emit1(26,0) {生成26号指令,进行类型转换}
1279 else if x.typ <> notyp {如果没有获取到表达式的类型}
1280 then error(36); {报36号错,参数类型异常}
1281 end
1282 else begin { variable parameter } {如果是变量形参}
1283 if sy <> ident {变量形参应该先识别到标识符}
1284 then error(2) {若不是标识符开头,报2号错}
1285 else begin {如果是标识符开头}
1286 k := loc(id); {找到当前id在表中的位置}
1287 insymbol; {获取下一个符号}
1288 if k <> 0 {在符号表中找到了id}
1289 then begin
1290 if tab[k].obj <> vvariable {如果获取到的形参类型不是变量类型}
1291 then error(37); {报37号错}
1292 x.typ := tab[k].typ; {否则记录当前的符号类型}
1293 x.ref := tab[k].ref; {记录当前参数指向的btab的位置}
1294 if tab[k].normal {如果是值形参}
1295 then emit2(0,tab[k].lev,tab[k].adr) {将变量地址装入栈顶}
1296 else emit2(1,tab[k].lev,tab[k].adr); {将变量的值装入栈顶(对应变量形参)}
1297 if sy in [lbrack, lparent, period] {如果后面跟的可以是做中括号(数组下标),左括号(容错)或句号(对应记录)}
1298 then
1299 selector(fsys+[comma,colon,rparent],x); {调用分析子结构的过程来处理}
1300 if ( x.typ <> tab[cp].typ ) or ( x.ref <> tab[cp].ref ) {如果参数的符号类型或所在表中的位置和符号表中记录的不同}
1301 then error(36) {报36号错误}
1302 end
1303 end
1304 end {variable parameter }
1305 end;
1306 test( [comma, rparent],fsys,6) {检查当前sym是否合法}
1307 until sy <> comma; {直到出现的不是都好,说明参数声明结束了}
1308 if sy = rparent {补齐右括号}
1309 then insymbol {获取下一个sym}
1310 else error(4) {没有右括号,报4号错误}
1311 end;
1312 if cp < lastp {如果当前符号的位置没有到达最后一个符号的位置}
1313 then error(39); { too few actual parameters } {报39号错误,说明符号没有处理完}
1314 emit1(19,btab[tab[i].ref].psize-1 ); {生成19号CAL指令,正式开始过程或函数调用}
1315 if tab[i].lev < level {如果符号所在层次小于当前层次}
1316 then emit2(3,tab[i].lev, level ) {更新display区}
1317 end { call };
1318
1319 function resulttype( a, b : types) :types; {处理整型或实型两个操作数运算时的类型转换}
1320 begin
1321 if ( a > reals ) or ( b > reals ) {如果有操作数超过上限报33号错误}
1322 then begin
1323 error(33);
1324 resulttype := notyp {返回nottype}
1325 end
1326 else if ( a = notyp ) or ( b = notyp ) {两个操作数中有一个nottype}
1327 then resulttype := notyp {结果返回nottype}
1328 else if a = ints {第一个是int}
1329 then if b = ints {第二个也是int}
1330 then resulttype := ints {返回int类型}
1331 else begin
1332 resulttype := reals; {否则结果为real}
1333 emit1(26,1) {并对a进行类型转化}
1334 end
1335 else begin
1336 resulttype := reals; {第一个是real,则返回real}
1337 if b = ints {如果第二个是int}
1338 then emit1(26,0) {对b进行转化}
1339 end
1340 end { resulttype } ;
1341
1342 procedure expression( fsys: symset; var x: item ); {处理表达式的过程,返回类型和在表中的位置}
1343 var y : item;
1344 op : symbol;
1345
1346 procedure simpleexpression( fsys: symset; var x: item );
1347 var y : item;
1348 op : symbol;
1349
1350 procedure term( fsys: symset; var x: item );
1351 var y : item;
1352 op : symbol;
1353
1354 procedure factor( fsys: symset; var x: item );{处理因子的子过程}
1355 var i,f : integer;
1356
1357 procedure standfct( n: integer ); {处理标准函数的子过程，传入标准函数的编号n，执行不同的操作}
1358 var ts : typset; {类型集合}
1359 begin { standard function no. n }
1360 if sy = lparent {如果当前的符号是左括号}
1361 then insymbol {获取下一个sym}
1362 else error(9); {如果当前符号不是左括号,报9号错误提示左括号出错}
1363 if n < 17 {如果标准函数的编号小于17}
1364 then begin
1365 expression( fsys+[rparent], x ); {递归调用处理表达式的过程来处理参数,x是获取的参数的信息}
1366 case n of {根据不同的函数编号来进行操作}
1367 { abs, sqr } 0,2: begin {如果是0,2号操作,完成求绝对值和平方}
1368 ts := [ints, reals]; {定义符号集合为整型和实型}
1369 tab[i].typ := x.typ; {函数的返回值类型}
1370 if x.typ = reals {如果参数类型是实数}
1371 then n := n + 1 {对应的函数标号+1}
1372 end;
1373 { odd, chr } 4,5: ts := [ints]; {如果是4,5号操作,那么完成判奇和ascii码转化成字符的操作,要求传入的是脏呢挂车能}
1374 { odr } 6: ts := [ints,bools,chars]; {6号操作允许类型是整型,布尔型或者字符型}
1375 { succ,pred } 7,8 : begin {对于7,8号操作}
1376 ts := [ints, bools,chars]; {允许参数类型是整型,布尔型或者字符型}
1377 tab[i].typ := x.typ {记录类型}
1378 end;
1379 { round,trunc } 9,10,11,12,13,14,15,16: {数学运算}
1380 { sin,cos,... } begin
1381 ts := [ints,reals]; {允许参数类型为整型,实型}
1382 if x.typ = ints {如果为整型}
1383 then emit1(26,0) {先将整型转成实型}
1384 end;
1385 end; { case }
1386 if x.typ in ts {如果函数的类型符合要求的符号集}
1387 then emit1(8,n) {调用8号指令,生成标准函数}
1388 else if x.typ <> notyp {如果x的类型未定义}
1389 then error(48); {报48号错误,类型错误}
1390 end
1391 else begin { n in [17,18] } {如果编号是17或者18,即判断输入是否结束}
1392 if sy <> ident {传入的首先应当是标识符}
1393 then error(2) {不是标识符报错}
1394 else if id <> 'input ' {如果对应的id不是'input '}
1395 then error(0) {报0号错误,未知id}
1396 else insymbol; {没错的话读取下一个sym}
1397 emit1(8,n); {生成标准函数}
1398 end;
1399 x.typ := tab[i].typ; {记录返回值类型}
1400 if sy = rparent {识别是否遇到右括号}
1401 then insymbol {获取下一个sym,标准函数处理过程结束}
1402 else error(4) {如果没有识别到右括号,报4号错误}
1403 end { standfct } ;
1404 begin { factor } {因子分析程序开始}
1405 x.typ := notyp; {初始化返回值类型}
1406 x.ref := 0; {初始化返回的位置指针}
1407 test( facbegsys, fsys,58 ); {检查当前的符号是否是合法的因子开始符号}
1408 while sy in facbegsys do {当当前的符号是因子的开始符号时}
1409 begin
1410 if sy = ident {如果识别到标识符}
1411 then begin
1412 i := loc(id); {获取当前标识符在符号表中的位置保存到i}
1413 insymbol; {获取下一个sym}
1414 with tab[i] do {对当前符号对应的表项进行操作}
1415 case obj of {对于不同的obj属性执行不同的操作}
1416 konstant: begin {如果是常量类型}
1417 x.typ := typ; {返回值的类型就设置为表中记录的typ}
1418 x.ref := 0; {索引值设置为0}
1419 if x.typ = reals {如果是实数类型的常量}
1420 then emit1(25,adr) {将实数装入数据栈,注意实数常量的adr对应着其在rconst实常量表中的位置}
1421 else emit1(24,adr) {如果是整型直接存入栈顶即可}
1422 end;
1423 vvariable:begin {如果换成变量类型}
1424 x.typ := typ; {获得需要返回类型}
1425 x.ref := ref; {获得需要返回地址}
1426 if sy in [lbrack, lparent,period] {如果标识符后面跟的是左方括号,左括号或者是句号,说明该变量存在子结构}
1427 then begin
1428 if normal {如果是实形参}
1429 then f := 0 {取地址}
1430 else f := 1; {否则是变量形参,取值并放到栈顶}
1431 emit2(f,lev,adr); {生成对应的代码}
1432 selector(fsys,x); {处理子结构}
1433 if x.typ in stantyps {如果是标准类型} {存疑}
1434 then emit(34) {将该值放到栈顶}
1435 end
1436 else begin {如果变量没有层次结构}
1437 if x.typ in stantyps {如果是标准类型}
1438 then if normal {如果是值形参}
1439 then f := 1 {执行取值操作}
1440 else f := 2 {否则间接取值}
1441 else if normal {如果不是标准类型但是是值形参}
1442 then f := 0 {取地址操作}
1443 else f := 1; {如果既不是标准类型又不是值形参,执行取值操作}
1444 emit2(f,lev,adr) {生成对应指令}
1445 end
1446 end;
1447 typel,prozedure: error(44); {如果是类型类型或者过程类型,报44号类型错误}
1448 funktion: begin {如果是函数符号}
1449 x.typ := typ; {记录类型}
1450 if lev <> 0 {如果层次不为0,即不是标准函数}
1451 then call(fsys,i) {调用call函数来处理函数调用}
1452 else standfct(adr) {如果层次为零,调用标准函数}
1453 end
1454 end { case,with }
1455 end
1456 else if sy in [ charcon,intcon,realcon ] {如果符号的类型是字符类型,整数类型或者实数类型}
1457 then begin
1458 if sy = realcon {对于实数类型}
1459 then begin
1460 x.typ := reals; {将返回的type设置为实型}
1461 enterreal(rnum); {将该实数放入实数表,rnum存有实数的值}
1462 emit1(25,c1) {将实常量表中第c1个(也就是刚刚放进去的)元素放入栈顶}
1463 end
1464 else begin
1465 if sy = charcon {对于字符类型}
1466 then x.typ := chars {记录返回的类型是字符型}
1467 else x.typ := ints; {否则肯定是整形啦,要不进不来这个分支}
1468View Code
本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。
