pl0(pascal version)编译器

program pl0(input,output);

{pl/0 compiler with code generation} label 99;

const norw = 11; {no. of reserved words} {保留字个数} txmax = 100; {length of identifier table} { 标识符变长度}

nmax = 14; {max. no. of digits in numbers}{ }

al = 10; {length of identifiers} {标识符的长度。。。。为10} 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,

{等号，标识符,数字, + , - ，* , / ,wsym[ 7] := oddsym } eql,neq,lss,leq,gtr,geq,lparen,rparen,comma,semicolon,

{=，#，<, [ , >, ], ( , ) , ‘ , ’, ; }

period,becomes,beginsym,endsym,ifsym,thensym,

{‘ . ’, 赋值，开始，结束，if , then } {不确定}

whilesym,dosym,callsym,constsym,varsym,procsym);

{while , do , call , const, var , procedure} {不确定}

alfa = packed array [1..al] of char;{字符数组，存放关键字}

object1 = (constant,varible,proc);{判断标识符是常量、变量还是过程？}

symset = set of symbol;

fct = (lit,opr,lod,sto,cal,int,jmp,jpc); {functions目标代码的功能码，具体如下：}

instruction = packed record {指令记录目标代码结构}

f: fct; {function code} {}

l: 0..levmax; {level层数}

a: 0..amax {displacement address}

end;

{ lit 0,a : load constant a

opr 0,a : execute operation a

lod l,a : load varible l,a

sto l,a : store varible 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 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;

code: array [0..cxmax] of instruction; {存放生成的目标代码}

word: array [1..norw] of alfa; {存放的关键字数组}

wsym: array [1..norw] of symbol; {标识符字符集}

ssym: array [char] of symbol; {符号语义字符集识别符号类似token.seman} mnemonic: array [fct] of

packed array [1..5] of char; {功能码字符数组} declbegsys, statbegsys, facbegsys: symset;

table: array [0..txmax] of { 符号表？？？}

record name: alfa;

case kind: object1 of

constant: (val: integer);

varible, proc: (level, adr: integer)

end;

fin:text; {存放源文件。。。}

sfile:string;

{----------------------------------------------------------------------------------------------------} 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 then {到达行尾}

begin if eof(fin) then {文件结束？}

begin write(' program incomplete'); {goto 99} {文件空，结束。}

close(fin);

exit;

end;

{文件没有结束时：}

ll := 0; cc := 0; write(cx: 5,' '); {行长度和字符个数清零，输出行数：}

while not eoln(fin) do {有回车（换行）时结束循环}

begin

ll := ll+1; read(fin,ch); write(ch); line[ll]:=ch

{此一行长度加1，读一个字符，回显，置于数组中}

end;

writeln; { 读入回车时，换行。。。。。。。。。。。。。。}

readln(fin); {。。。。。。。。}

ll := ll + 1; line[ll] := ' '; {}

end;

cc := cc+1; ch := line[cc] {读入一个字符}

end {getch};

begin {getsym} { getsys.....。。。。。} while ch = ' ' do getch; {空格过滤}

if ch in ['a'..'z'] then

begin {identifier or reserved word} k := 0; {标识符或者保留字} repeat if k < al then {读入一个完整的标识符或者保留字} begin k := k+1; a[k] := ch

end;

getch;

until not(ch in ['a'..'z','0'..'9']);

if k >= kk then kk := k else {如果关键字的个数不足十，补空格} repeat a[kk] := ' '; kk := kk-1

until kk = k;

id := a; i := 1; j := norw; {norw=11-}

repeat k := (i+j) div 2; {查找是否为保留字。。。。。。。。} if id <= word[k] then j := k-1;

if id >= word[k] then i := k+1

until i > j;

if i-1 > j then sym := wsym[k] else sym := ident {是标识符，将内部表示赋给sys…….否则，将”ident”赋给sys}

end else

if ch in ['0'..'9'] then {如果读入的是数字}

begin {number} k := 0; num := 0; sym := number;

repeat num := 10*num + (ord(ch)-ord('0')); {拼数。。。。。}

k := k+1; 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; getch {赋值语句。。。}

end else sym := nul; {非赋值语句，认为等号。。？？？} end else

begin sym := ssym[ch]; getch {其它符号。。。取seman赋给sys}

end

end {getsym};

{----------------------------------------------------------------------------------------------------} procedure gen(x: fct; y,z: integer);{生成目标代码。。。。。

目标代码功能码、层次、偏移量}

begin if cx > cxmax then

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};

{----------------------------------------------------------------------------------------------------} procedure test(s1,s2: symset; n: integer);{？？？？？？？？？？？？}

begin if not(sym in s1) then

begin error(n); s1 := s1 + s2;

while not(sym in s1) do getsym

end

end {test};

{----------------------------------------------------------------------------------------------------} procedure block(lev,tx: integer; fsys: symset);

{层次，table中位置，出错处理}

var dx: integer; {data allocation index局部量位置指示}

tx0: integer; {initial table index}

cx0: integer; {initial code index}

procedure enter(k: object1); {参数为变量、常量或者过程}

begin {enter object into table登记到符号表中。。。。}

tx := tx + 1; {符号表序号+1}

with table[tx] do

begin name := id; kind := k;{table[tx].name:=id登记名字，

table[tx].king:=k登记类型}

case k of {根据类型做处理。。。如下：}

{是常量。。。。。}

constant: begin if num > amax then{判断数值越界？}

begin error(30); num :=0 end;

val := num{不越界则赋值给val}

end;

{是变量。。。。}

varible: begin level := lev; adr := dx; dx := dx + 1;

{层数，偏移量存入，偏移量+1}

end;

{是过程。。。。}

proc: level := lev {保存层数}

end

end

end {enter};

{……………………………………………………}

function position(id: alfa): integer;{查找标识符在符号表中位置函数} var i: integer;

begin {find indentifier id in table}

table[0].name := id; i := tx; {tx为符号表标号最大值}

while table[i].name <> id do i := i-1; {从高到低查找}

position := i

end {position};

{----------------------------------------------------------------------------------------------------} procedure constdeclaration; {常量处理部分}

begin if sym = ident then {是标识符？否，出错}

begin getsym; {继续读}

if sym in [eql, becomes] then {是=或者:=？否，出错}

begin if sym = becomes then error(1);{是:=，错误1}

getsym; {读后面数字}

if sym = number then {是数字？否，出错。}

begin enter(constant); getsym

{填写符号表，继续读…}

end

else error(2)

end else error(3)

end else error(4)

end {constdeclaration};

{----------------------------------------------------------------------------------------------------} procedure vardeclaration; {变量处理….}

begin if sym = ident then {是标识符？否，出错}

begin enter(varible); getsym {填写符号表，继续读…}

end else error(4)

end {vardeclaration};

{----------------------------------------------------------------------------------------------------} procedure listcode; {显示中间代码}

var i: integer; {存放中间代码序号}

begin {list code generated for this block列出程序块中间代码}

for i := cx0 to cx-1 do

with code[i] do

writeln(i:5, mnemonic[f]:5, 1:3, a:5){输出序号，功能码} 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);

{判断因子起始符是否为标识符、符号、左括号？否，出错}

while sym in facbegsys do

begin

if sym = ident then {是标识符}

begin i:= position(id); {查找标识符表，没有，出错}

if i = 0 then error(11) else

with table[i] do {查到}

case kind of {根据类型生成中间代码}

constant: gen(lit, 0, val);

varible: gen(lod, lev-level, adr);

proc: error(21) {是过程，报错21}

end;

getsym

end

else

if sym = number then{是数字}

begin if num > amax then

begin error(30); num := 0

end;

gen(lit, 0, num); getsym

end else

if sym = lparen then {是左括号}

begin getsym; expression([rparen]+fsys);

if sym = rparen then getsym else error(22)

end;

test(fsys, [lparen], 23)

end

end {factor};

{…………………..………………………………………项的语法分析。。。}

begin {term} factor(fsys+[times, slash]);{调用因子语法分析}

while sym in [times, slash] do {读到的是*或者/}

{保存运算符；} {继续读；}{调用因子语法分析；}

begin mulop:=sym;getsym;factor(fsys+[times,slash]);

{生成中间代码}

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; term(fsys+[plus,minus]);

if addop = minus then gen(opr, 0,1)

end else term(fsys+[plus, minus]);{？？？？？？}

while sym in [plus, minus] do

begin addop := sym; getsym; term(fsys+[plus,minus]);

{生成中间代码}

if addop=plus then gen(opr,0,2) else gen(opr,0,3)

end

end {expression};

{----------------------------------------------------------------------------------------------------} procedure condition(fsys: symset); {条件语法检查，生成中间代码} var relop: symbol;

begin

if sym = oddsym then{是奇数关键字odd}

{继续读；}{表达式语法分析；}{中间代码生成}

begin getsym; expression(fsys); gen(opr, 0, 6)

end else{非奇数关键字……………………………………….}

begin expression([eql, neq, lss, gtr, leq, geq]+fsys);

if not(sym in [eql, neq, lss, leq, gtr, geq]) then

error(20) else

begin relop := sym; getsym; expression(fsys);

{保存符号到relop，继续表达式语法检查}

case relop of

eql: gen(opr, 0, 8);

neq: gen(opr, 0, 9);

lss: gen(opr, 0, 10);

geq: gen(opr, 0, 11);

gtr: gen(opr, 0, 12);

leq: gen(opr, 0, 13);

end

end

end

end {condition};

{。。。。。。。。。。。。。。。。。。。。。。语句的语法分析，生成中间代码。。。。。。。。。。。。。。。。。。} begin {statement}

if sym = ident then {是标识符}

begin i := position(id); {查找位置}

if i = 0 then error(11) else {未定义错误}

if table[i].kind <> varible then{不是变量，错误12}

begin {assignment to non-varible} error(12); i := 0

end;

getsym; {继续读}

if sym = becomes then getsym else error(13);{是:=继续读，否，错误13}

expression(fsys); {表达式语法分析}

if i <> 0 then {如果在表中}

with table[i] do gen(sto, lev-level, adr){}

end else

{…………………………………………..对call语句的语法分析}

if sym = callsym then

begin getsym;{继续读}

if sym <> ident then error(14) else {是标识符？否，错误14}

begin i := position(id); {查找位置，没有错误11}

if i = 0 then error(11) else

with table[i] do

{是过程，生成中间代码；否，错误15}

if kind=proc then gen(cal, lev-level, adr)

else error(15);

getsym {继续读}

end

end else

{…………………………………………..if的语法分析}

if sym = ifsym then

{继续读；}{条件语法分析；}

begin getsym; condition([thensym, dosym]+fsys);

if sym = thensym then getsym else error(16);{是then?否，错误16}

cx1 := cx; gen(jpc, 0, 0); {目标代码序号赋给cx1}

statement(fsys); code[cx1].a := cx

end else

{…………………………………………………………begin语法分析} if sym = beginsym then {………………………………………………..调用语句语法分析程序} begin getsym; statement([semicolon, endsym]+fsys);

while sym in [semicolon]+statbegsys do{？？？？？？？？}

begin

if sym = semicolon then getsym else error(10);

statement([semicolon, endsym]+fsys)

end;

if sym = endsym then getsym else error(17){…..end结束？否，错误17} end else {。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。对while语法分析。。。。。。。} if sym = whilesym then

{。。。。。。继续读；条件语法分析。。。。。。。}

begin cx1 := cx; getsym; condition([dosym]+fsys);

cx2 := cx; gen(jpc, 0, 0);

if sym = dosym then getsym else error(18);

statement(fsys); gen(jmp, 0, cx1); code[cx2].a := cx

end;

test(fsys, [], 19)

end {statement};

{------------------------------------------block程序块开始-------------------------------} begin {。。。。。。。。。。block。。。。。。。。}

dx:=3;

tx0:=tx; {表头索引值。。。}

table[tx].adr:=cx; {目标代码索引。。。}

gen(jmp,0,0);

if lev > levmax then error(32); {如果超过最大深度，报错32}

repeat{。。。。。。。。常量定义语法分析。。。。。。。。。。。。。。。}

if sym = constsym then {。。。为常量}

begin getsym; {继续读。。。。}

repeat constdeclaration; {调用常量声明处理。。判断….}

while sym = comma do {读到，……}

begin getsym; constdeclaration {继续读，继续处理。。。}

end;

if sym = semicolon then getsym else error(5){读到分号，继续读下一个}

until sym <> ident{非标识符…结束循环管}

end;

{……………………………..对变量语法处理}

{a::=var <标识符>{，<标识符>}}

if sym = varsym then

begin getsym; {….读下一个}

repeat vardeclaration; {变量声明处理}

while sym = comma do {读到，}

begin getsym; vardeclaration {读下一个；变量声明处理}

end;

if sym = semicolon then getsym else error(5)

{结尾是；？否，错误5}

until sym <> ident;

end;

{。。。。。。。。。。。。对过程的语法处理}

while sym = procsym do

begin getsym; {………………………..继续读}

if sym = ident then {标识符？否，错误4…..}

begin enter(proc); getsym {查表，是否已经定义。。。}

end

else error(4);

if sym = semicolon then getsym else error(5);{是分号？否，出错} {是，继续读}

block(lev+1, tx, [semicolon]+fsys); {递归调用，，层次+1}

if sym = semicolon then {是分号？否，错误5}

{是，继续读。。。。。。}

begin getsym;test(statbegsys+[ident,procsym],fsys,6)

end

else error(5)

end;

test(statbegsys+[ident], declbegsys, 7)

until not(sym in declbegsys);

code[table[tx0].adr].a := cx;

with table[tx0] do

begin adr := cx; {start adr of code}

end;

cx0 := 0{cx}; gen(int, 0, dx);

statement([semicolon, endsym]+fsys);

gen(opr, 0, 0); {return}

test(fsys, [], 8);

listcode;

end {block};

{----------------------------------------------------------------------------------------------------} {解释执行程序。。。。}

procedure interpret;

const stacksize = 500; {堆大小}

var p,b,t: integer; {program-, base-, topstack-registers}

i: instruction; {instruction register}

s: array [1..stacksize] of integer; {datastore}

function base(l: integer): integer;

var b1: integer;

begin b1 := b; {find base l levels down}

while l > 0 do

begin b1 := s[b1]; l := l - 1

end;

base := b1

end {base};

begin writeln(' start pl/0');

t := 0; b := 1; p := 0; {栈顶，栈底，目标代码序号}

s[1] := 0; s[2] := 0; s[3] := 0;

repeat i := code[p]; p := p + 1;

with i do

case f of

lit: begin t := t + 1; s[t] := a {栈顶指针+1，常量值a放到栈顶。。。} end;

opr: case a of {operator}

0: begin {return}

t := b - 1; p := s[t + 3]; b := s[t + 2];

end;

1: s[t] := -s[t]; {栈顶元素取反。。}

2: begin t := t - 1; s[t] := s[t] + s[t + 1] {次栈顶和栈顶元素相加。。。} end;

3: begin t := t - 1; s[t] := s[t] - s[t + 1]

end;

4: begin t := t - 1; s[t] := s[t] * s[t + 1]

end;

5: begin t := t - 1; s[t] := s[t] div s[t + 1]

end;

6: s[t] := ord(odd(s[t]));{栈顶元素奇偶判断，结果值在栈顶}

8: begin t := t - 1; s[t] := ord(s[t] = s[t + 1]){次栈顶与栈顶是否相等} end;

9: begin t := t - 1; s[t] := ord(s[t] <> s[t + 1]) {次栈顶与栈顶是否不相等}

end;

10: begin t := t - 1; s[t] := ord(s[t] < s[t + 1]){次栈顶是否小于栈顶}

end;

11: begin t := t - 1; s[t] := ord(s[t] >= s[t + 1])

end;

12: begin t := t - 1; s[t] := ord(s[t] > s[t + 1])

end;

13: begin t := t - 1; s[t] := ord(s[t] <= s[t + 1])

end;

end;

lod: begin t := t + 1; s[t] := s[base(l) + a]{栈顶指针+1，将变量a取到栈顶} end;

sto: begin s[base(l)+a] := s[t]; writeln(s[t]); t := t – 1{将栈顶内容送到某变量单元中。。。}

end;

cal: begin {generate new block mark}

s[t + 1] := base(l); s[t + 2] := b; s[t + 3] := p;

b := t + 1; p := a

end;

int: t := t + a;{栈顶指针移动a个单元，开辟a大小的空间}

jmp: p := a; {跳到目标代码为序号a的地方}

jpc: begin if s[t] = 0 then p := a; t := t – 1{如果栈顶为0，跳转到a,否则顺序执行。。}

end

end {with, case}

until p = 0;

write(' end pl/0');

end {interpret};

{----------------------------------------------------------------------------------------------------} begin {main program} {主程序}

writeln('please input source program file name:');

readln(sfile);

assign(fin,sfile);

reset(fin);

for ch := chr(0) to chr(255) do ssym[ch] := nul; {初始化为空。。。。。。。。。}

{。。。。。。。。。。。。。。。。。。。。。。。。11个关键字的内部表示…………………………..} 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] := 'then '; word[10] := 'var ';

word[11] := 'while ';

{…………………………token 初始化…………………………………………..} 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] := thensym; wsym[10] := varsym;

wsym[11] := whilesym;

{…………………………….符号的token……………………………………} ssym[ '+'] := plus; ssym[ '-'] := minus;

ssym[ '*'] := times; ssym[ '/'] := slash;

ssym[ '('] := lparen; ssym[ ')'] := rparen;

ssym[ '='] := eql; ssym[ ','] := comma;

ssym[ '.'] := period; ssym[ '#'] := neq;

ssym[ '<'] := lss; ssym[ '>'] := gtr;

ssym[ '['] := leq; ssym[ ']'] := geq;

ssym[ ';'] := semicolon; {……………………………..？？？？？？？？？？？？？…………………} mnemonic[lit] := ' lit'; mnemonic[opr] := ' opr';

mnemonic[lod] := ' lod'; mnemonic[sto] := ' sto';

mnemonic[cal] := ' cal'; mnemonic[int] := ' int';

mnemonic[jmp] := ' jmp'; mnemonic[jpc] := ' jpc';

declbegsys := [constsym, varsym, procsym];

statbegsys := [beginsym, callsym, ifsym, whilesym];

facbegsys := [ident, number, lparen];

{page(output);}

err := 0;

cc := 0; {初始化读入字符数0}

cx := 0;

ll := 0; {初始化读入行数0}

ch := ' '; {字符变量}

kk := al; {初始化kk（关键字）长度al:=10 }

getsym; {调用词法分析}

block(0, 0, [period]+declbegsys+statbegsys);{ 。。。。。。调用？？？？？} if sym <> period then error(9); { 错误提示。。。。。。。} if err=0 then interpret else write(' errors in pl/0 program');

{没有错误，解释。。。。}

99: writeln

end.