PL0Compiler
github地址：https://github.com/wuzht/PL0Compiler
實驗內容
- 在計算機上實現PL0語言的編譯程序
- 擴展PL0語言的功能，並在計算機上實現
實驗要做的工作
- 找到PASCAL編譯系統(Delphi系統也可以)
- 在PASCAL系統上運行PL0編譯程序,需要對PL0編譯程序作一些修改、調試
- 在PASCAL系統中，爲PL0的編譯程序建立輸入文件和輸出文件
- 在輸入文件中存放PL0源程序
- 在輸出文件中存放PL0源程序被編譯後產生的中間代碼和運行數據
- PL0的編譯程序運行時，通過輸入文件輸入PL0源程序，在輸出文件中產生源程序的中間代碼然後運行該中間代碼，在輸出文件中產生運行數據
- 如果上述工作成功，則第一項實習任務完成.再做以下工作
- 在PL0語言中增加Read和Write語句
- 修改PL0編譯程序, 使得PL0源程序可以使用Read和Write語句，從文件(或鍵盤)輸入數據，並可以向文件(或屏幕)寫數據
- 若以上工作完成, 則第2項實驗任務完成
編譯系統
Free Pascal: https://www.freepascal.org/
編譯運行截圖
Part 1
Part 2
PL0源程序
Part 1
src.pas
const m = 7, n = 85;
var x, y, z, q, r;
procedure multiply;
var a, b;
begin a := x; b := y; z := 0;
while b > 0 do
begin
if odd b then z := z + a;
a := 2*a ; b := b/2 ;
end
end;
procedure divide;
var w;
begin r := x; q := 0; w := y;
while w @ r do w := 2*w ;
while w > y do
begin q := 2*q; w := w/2;
if w @ r then
begin r := r-w; q := q+1 end
end
end;
procedure gcd;
var f, g ;
begin f := x; g := y;
while f ! g do
begin
if f < g then g := g-f;
if g < f then f := f-g;
end;
z := f
end;
begin
x := m; y := n; call multiply;
x := 25; y:= 3; call divide;
x := 84; y := 36; call gcd;
end.
Part 2
rwsrc.pas
var input;
begin
read(input);
write(input);
end.
PL0編譯程序
{PL0編譯程序註釋}
Program PL0 (input, output);
{帶有代碼生成的PL0編譯程序}
Const
norw = 13; {保留字的個數}
txmax = 100; {標識符表長度}
nmax = 14; {數字的最大位數}
al = 10; {標識符的長度}
amax = 2047; {最大地址}
levmax = 3; {程序體嵌套的最大深度}
cxmax = 200; {代碼數組的大小}
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);
alfa = packed array [1..al] Of char;
Object2 = (constant, variable, Procedure2);
symset = set Of symbol;
fct = (lit, opr, lod, sto, cal, int, jmp, jpc, red, wrt); {functions}
instruction = packed Record
f : fct; {功能碼}
l : 0..levmax; {相對層數}
a : 0..amax; {相對地址}
End;
{LIT 0,a : 取常數a
OPR 0,a : 執行運算a
LOD l,a : 取層差爲l的層﹑相對地址爲a的變量
STO l,a : 存到層差爲l的層﹑相對地址爲a的變量
CAL l,a : 調用層差爲l的過程
INT 0,a : t寄存器增加a
JMP 0,a : 轉移到指令地址a處
JPC 0,a : 條件轉移到指令地址a處 }
Var
ch : char; {最近讀到的字符}
sym : symbol; {最近讀到的符號}
id : alfa; {最近讀到的標識符}
num : integer; {最近讀到的數}
cc : integer; {當前行的字符計數}
ll : integer; {當前行的長度}
kk, err : integer;
cx : integer; {代碼數組的當前下標}
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; {存放算符和標點符號的記號}
mnemonic : array [fct] Of packed array [1..5] Of char;
{中間代碼算符的字符串}
declbegsys, statbegsys, facbegsys : symset;
table : array [0..txmax] Of {符號表}
Record
name : alfa;
Case kind : Object2 Of constant : (val : integer);
variable, Procedure2 : (level, adr : integer)
End;
fin, fout : text; {fin, fout是文本文件}
srcfile, dstfile : string;
Procedure error (n : integer);
Begin
writeln('****', ' ' : cc-1, '^', n : 2);
err := err + 1
{cc爲當前行已讀的字符數, n爲錯誤號}{錯誤數err加1}
End {error};
Procedure getsym;
Var i, j, k : integer;
Procedure getch; {取下一字符}
Begin If cc = ll Then {如果cc指向行末}
Begin If eof(fin) Then {如果已到文件尾}
Begin
write('Program INCOMPLETE');
writeln(fout, 'Program INCOMPLETE');
close(fin);
close(fout);
// goto 99
exit(); {相當於goto 99}
End;
{讀新的一行}
ll := 0;
cc := 0;
write(cx : 5, ' '); {cx : 5位數}
write(fout, cx : 5, ' ');
While not eoln(fin) Do {如果不是行末}
Begin
ll := ll + 1;
read(fin, ch);
write(ch);
write(fout, ch);
line[ll] := ch {一次讀一行入line}
End;
writeln;
writeln(fout);
readln(fin);
ll := ll + 1;
// read(line[ll]) {line[ll]中是行末符}
line[ll] := ' '
End;
cc := cc + 1;
ch := line[cc] {ch取line中下一個字符}
End {getch};
Begin {getsym}
while ch = ' ' do
getch; {跳過無用空白}
If ch In ['a'..'z'] Then
Begin {標識符或保留字}
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;
{id中存放當前標識符或保留字的字符串}
Repeat
k := (i+j) Div 2; {用二分查找法在保留字表中找當前的標識符id}
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
{如果找到, 當前記號sym爲保留字, 否則sym爲標識符}
End
Else If ch In ['0'..'9'] Then
Begin {數字}
k := 0; num := 0; sym := number; {當前記號sym爲數字}
Repeat {計算數字串的值}
num := 10*num + (ord(ch)-ord('0'));
{ord(ch)和ord(0)是ch和0在ASCII碼中的序號}
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
End
End {getsym};
Procedure gen(x : fct; y, z : integer);
Begin
If cx > cxmax Then {如果當前指令序號>代碼的最大長度}
Begin
write('Program TOO LONG');
writeln(fout);
close(fin);
// goto 99
exit();
End;
With code[cx] Do {在代碼數組cx位置生成一條新代碼}
Begin
f := x; {功能碼}
l := y; {層號}
a := z {地址}
End;
cx := cx + 1 {指令序號加1}
End {gen};
Procedure test(s1, s2 : symset; n : integer);
Begin
If not (sym In s1) Then
{如果當前記號不屬於集合S1,則報告錯誤n}
Begin
error(n);
s1 := s1 + s2;
While not (sym In s1) Do
getsym
{跳過一些記號, 直到當前記號屬於S1∪S2}
End
End {test};
Procedure block(lev, tx : integer; fsys : symset);
Var dx : integer; {本過程數據空間分配下標}
tx0 : integer; {本過程標識表起始下標}
cx0 : integer; {本過程代碼起始下標}
Procedure enter(k : Object2);
Begin {把object填入符號表中}
tx := tx +1; {符號表指針加1}
With table[tx] Do{在符號表中增加新的一個條目}
Begin
name := id; {當前標識符的名字}
kind := k; {當前標識符的種類}
Case k Of
constant :
Begin {當前標識符是常數名}
If num > amax Then {當前常數值大於上界,則出錯}
Begin error(30); num := 0 End;
val := num
End;
variable :
Begin {當前標識符是變量名}
level := lev; {定義該變量的過程的嵌套層數}
adr := dx; {變量地址爲當前過程數據空間棧頂}
dx := dx +1; {棧頂指針加1}
End;
Procedure2 : level := lev {本過程的嵌套層數}
End
End
End {enter};
Function position(id : alfa) : integer; {返回id在符號表的入口}
Var i : integer;
Begin {在標識符表中查標識符id}
table[0].name := id; {在符號表棧的最下方預填標識符id}
i := tx; {符號表棧頂指針}
While table[i].name <> id Do i := i-1;
{從符號表棧頂往下查標識符id}
position := i {若查到,i爲id的入口,否則i=0 }
End {position};
Procedure constdeclaration;
Begin
If sym = ident Then {當前記號是常數名}
Begin
getsym;
If sym In [eql, becomes] Then {當前記號是等號或賦值號}
Begin
If sym = becomes Then error(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(variable); {將該變量名加入符號表的下一條目}
getsym
End
Else error(4) {如果變量說明未出現標識符,則出錯}
End {vardeclaration};
Procedure listcode;
Var i : integer;
Begin {列出本程序體生成的代碼}
For i := cx0 To cx-1 Do
{cx0: 本過程第一個代碼的序號, cx-1: 本過程最後一個代碼的序號}
With code[i] Do {打印第i條代碼}
writeln(fout, i:3, mnemonic[f] : 5, l : 3, a : 5)
{i: 代碼序號;
mnemonic[f]: 功能碼的字符串;
l: 相對層號(層差);
a: 相對地址或運算號碼}
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); {查符號表,返回id的入口}
If i = 0 Then error(11)
Else
{若在符號表中查不到id, 則出錯, 否則,做以下工作}
With table[i] Do
Case kind Of
constant : gen(lit, 0, val);
{若id是常數, 生成指令,將常數val取到棧頂}
variable : gen(lod, lev-level, adr);
{若id是變量, 生成指令,將該變量取到棧頂;
lev: 當前語句所在過程的層號;
level: 定義該變量的過程層號;
adr: 變量在其過程的數據空間的相對地址}
Procedure2 : error(21)
{若id是過程名, 則出錯}
End;
getsym {取下一記號}
End
Else If sym = number Then {當前記號是數字}
Begin
If num > amax Then {若數值越界,則出錯}
Begin
error(30);
num := 0
End;
gen(lit, 0, num);
{生成一條指令, 將常數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 {while}
End {factor};
Begin {term}
factor(fsys+[times, slash]); {處理項中第一個因子}
While sym In [times, slash] Do
{當前記號是“乘”或“除”號}
Begin
mulop := sym; {運算符存入mulop}
getsym; {取下一記號}
factor(fsys+[times, slash]); {處理一個因子}
If mulop = times Then gen(opr, 0, 4)
{若mulop是“乘”號,生成一條乘法指令}
Else gen(opr, 0, 5)
{否則, mulop是除號, 生成一條除法指令}
End
End {term};
Begin {expression}
If sym In [plus, minus] Then {若第一個記號是加號或減號}
Begin
addop := sym; {“+”或“-”存入addop}
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; {當前算符存入addop}
getsym; {取下一記號}
term(fsys+[plus, minus]); {處理一個項}
If addop = plus Then gen(opr, 0, 2)
{若addop是加號, 生成一條加法指令}
Else gen(opr, 0, 3)
{否則, addop是減號, 生成一條減法指令}
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 {如果當前記號不是“odd”}
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; {關係符存入relop}
getsym; {取下一記號}
expression(fsys); {處理關係符右邊的算術表達式}
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);
{在符號表中查id, 返回id在符號表中的入口}
If i = 0 Then error(11)
{若在符號表中查不到id, 則出錯, 否則做以下工作}
Else If table[i].kind <> variable Then
{若標識符id不是變量, 則出錯}
Begin {對非變量賦值}
error(12);
i := 0;
End;
getsym; {取下一記號}
If sym = becomes Then getsym
Else error(13);
{若當前是賦值號, 取下一記號, 否則出錯}
expression(fsys); {處理表達式}
If i <> 0 Then {若賦值號左邊的變量id有定義}
With table[i] Do gen(sto, lev-level, adr)
{生成一條存數指令, 將棧頂(表達式)的值存入變量id中;
lev: 當前語句所在過程的層號;
level: 定義變量id的過程的層號;
adr: 變量id在其過程的數據空間的相對地址}
End
Else If sym = callsym Then {處理過程調用語句}
Begin
getsym; {取下一記號}
If sym <> ident Then error(14)
Else
{如果下一記號不是標識符(過程名),則出錯,
否則做以下工作}
Begin
i := position(id); {查符號表,返回id在表中的位置}
If i = 0 Then error(11)
Else
{如果在符號表中查不到, 則出錯; 否則,做以下工作}
With table[i] Do
If kind = Procedure2 Then
{如果在符號表中id是過程名}
gen(cal, lev-level, adr)
{生成一條過程調用指令;
lev: 當前語句所在過程的層號
level: 定義過程名id的層號;
adr: 過程id的代碼中第一條指令的地址}
Else error(15); {若id不是過程名,則出錯}
getsym {取下一記號}
End
End
Else If sym = ifsym Then {處理條件語句}
Begin
getsym; {取下一記號}
condition([thensym, dosym]+fsys); {處理條件表達式}
If sym = thensym Then getsym
Else error(16);
{如果當前記號是“then”,則取下一記號; 否則出錯}
cx1 := cx; {cx1記錄下一代碼的地址}
gen(jpc, 0, 0);
{生成指令,表達式爲“假”轉到某地址(待填),
否則順序執行}
statement(fsys); {處理一個語句}
code[cx1].a := cx
{將下一個指令的地址回填到上面的jpc指令地址欄}
End
Else 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”,則取下一記號,否則出錯}
End
Else If sym = whilesym Then {處理循環語句}
Begin
cx1 := cx; {cx1記錄下一指令地址,即條件表達式的
第一條代碼的地址}
getsym; {取下一記號}
condition([dosym]+fsys); {處理條件表達式}
cx2 := cx; {記錄下一指令的地址}
gen(jpc, 0, 0); {生成一條指令,表達式爲“假”轉到某地
址(待回填), 否則順序執行}
If sym = dosym Then getsym
Else error(18);
{如果當前記號是“do”,則取下一記號, 否則出錯}
statement(fsys); {處理“do”後面的語句}
gen(jmp, 0, cx1); {生成無條件轉移指令, 轉移到“while”後的
條件表達式的代碼的第一條指令處}
code[cx2].a := cx
{把下一指令地址回填到前面生成的jpc指令的地址欄}
End
{###################### read語句 ######################}
Else If sym = readsym Then {處理read語句}
Begin
getsym; {取下一記號}
If sym = lparen Then {如果read後跟的是左括號}
Repeat
getsym;
If sym = ident Then
Begin
i := position(id);
{在符號表中查id, 返回id在符號表中的入口}
If i = 0 Then error(11)
{若在符號表中查不到id, 則出錯, 否則做以下工作}
Else If table[i].kind <> variable Then
{若標識符id不是變量, 則出錯}
Begin {對非變量賦值}
error(12);
i := 0;
End
Else With table[i] Do gen(red, lev-level, adr)
{生成一條RED指令;
lev: 當前語句所在過程的層號;
level: 定義變量id的過程的層號;
adr: 變量id在其過程的數據空間的相對地址}
End
Else error(4); {如果變量說明未出現標識符,則出錯}
getsym;
Until sym <> comma {直到當前記號不是逗號}
Else error(40); {如果read後跟的不是左括號,出錯}
If sym <> rparen Then error(22); {漏右括號,出錯}
getsym
End {處理read語句}
{###################### write語句 ######################}
Else if sym = writesym Then {處理write語句}
Begin
getsym; {取下一記號}
If sym = lparen Then {如果write後跟的是左括號}
Begin
Repeat
getsym;
expression([rparen,comma]+fsys);
gen(wrt, 0, 0);
Until sym <> comma; {直到當前記號不是逗號}
If sym <> rparen Then error(22); {漏右括號,出錯}
getsym
End
Else error(40) {如果write後跟的不是左括號,出錯}
End; {處理write語句}
test(fsys, [ ], 19)
{測試下一記號是否正常, 否則出錯, 跳過一些記號}
End {statement};
Begin {block}
dx := 3; {本過程數據空間棧頂指針}
tx0 := tx; {標識符表的長度(當前指針)}
table[tx].adr := cx; {本過程名的地址, 即下一條指令的序號}
gen(jmp, 0, 0); {生成一條轉移指令}
If lev > levmax Then error(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;
If sym = varsym Then {當前記號是變量說明語句開始符號}
Begin
getsym;
Repeat
vardeclaration; {處理一個變量說明}
While sym = comma Do {如果當前記號是逗號}
Begin
getsym;
vardeclaration
End;
{處理下一個變量說明}
If sym = semicolon Then getsym
Else error(5)
{如果當前記號是分號,則變量說明已處理完, 否則出錯}
Until sym <> ident;
{跳過一些記號, 直到當前記號不是標識符(出錯時纔用到)}
End;
While sym = procsym Do {處理過程說明}
Begin
getsym;
If sym = ident Then {如果當前記號是過程名}
Begin
enter(Procedure2);
getsym
End
{把過程名填入符號表}
Else error(4); {否則, 缺少過程名出錯}
If sym = semicolon Then getsym
Else error(5);
{當前記號是分號, 則取下一記號,否則,過程名後漏掉分號出錯}
block(lev+1, tx, [semicolon]+fsys); {處理過程體}
{lev+1: 過程嵌套層數加1; tx: 符號表當前棧頂指針,
也是新過程符號表起始位置; [semicolon]+fsys: 過程體開始和末尾符號集}
If sym = semicolon Then {如果當前記號是分號}
Begin
getsym; {取下一記號}
test(statbegsys+[ident, procsym], fsys, 6)
{測試當前記號是否語句開始符號或過程說明開始符號,
否則報告錯誤6, 並跳過一些記號}
End
Else error(5) {如果當前記號不是分號,則出錯}
End; {while}
test(statbegsys+[ident], declbegsys, 7)
{檢測當前記號是否語句開始符號, 否則出錯, 並跳過一些記號}
Until not (sym In declbegsys);
{回到說明語句的處理(出錯時才用),直到當前記號不是說明語句的開始符號}
code[table[tx0].adr].a := cx;
{table[tx0].adr是本過程名的第1條
代碼(jmp, 0, 0)的地址,本語句即是將下一代碼(本過程語句的第
1條代碼)的地址回填到該jmp指令中,得(jmp, 0, cx)}
With table[tx0] Do {本過程名的第1條代碼的地址改爲下一指令地址cx}
Begin
adr := cx; {代碼開始地址}
End;
cx0 := cx; {cx0記錄起始代碼地址}
gen(int, 0, dx); {生成一條指令, 在棧頂爲本過程留出數據空間}
statement([semicolon, endsym]+fsys); {處理一個語句}
gen(opr, 0, 0); {生成返回指令}
test(fsys, [ ], 8); {測試過程體語句後的符號是否正常,否則出錯}
listcode; {打印本過程的中間代碼序列}
End {block};
Procedure interpret;
Const stacksize = 500; {運行時數據空間(棧)的上界}
Var p, b, t : integer; {程序地址寄存器, 基地址寄存器,棧頂地址寄存器}
i : instruction; {指令寄存器}
s : array [1..stacksize] Of integer; {數據存儲棧}
Function base(l : integer) : integer;
Var b1 : integer;
Begin
b1 := b; {順靜態鏈求層差爲l的外層的基地址}
While l > 0 Do
Begin
b1 := s[b1];
l := l-1
End;
base := b1
End {base};
Begin
writeln('START PL/0');
writeln(fout, 'START PL/0');
t := 0; {棧頂地址寄存器}
b := 1; {基地址寄存器}
p := 0; {程序地址寄存器}
s[1] := 0;
s[2] := 0;
s[3] := 0;
{最外層主程序數據空間棧最下面預留三個單元}
{每個過程運行時的數據空間的前三個單元是:SL, DL, RA;
SL: 指向本過程靜態直接外層過程的SL單元;
DL: 指向調用本過程的過程的最新數據空間的第一個單元;
RA: 返回地址 }
Repeat
i := code[p]; {i取程序地址寄存器p指示的當前指令}
p := p+1; {程序地址寄存器p加1,指向下一條指令}
With i Do
Case f Of
lit :
Begin {當前指令是取常數指令(lit, 0, a)}
t := t+1;
s[t] := a
End;
{棧頂指針加1, 把常數a取到棧頂}
opr : Case a Of {當前指令是運算指令(opr, 0, a)}
0 :
Begin {a=0時,是返回調用過程指令}
t := b-1; {恢復調用過程棧頂}
p := s[t+3]; {程序地址寄存器p取返回地址}
b := s[t+2]; {基地址寄存器b指向調用過程的基地址}
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]));
{算s[t]是否奇數, 是則s[t]=1, 否則s[t]=0}
8 :
Begin
t := t-1;
s[t] := ord(s[t] = s[t+1])
End;
{判兩個表達式的值是否相等,是則s[t]=1,否則s[t]=0}
9:
Begin
t := t-1;
s[t] := ord(s[t] <> s[t+1])
End;
{判兩個表達式的值是否不等,是則s[t]=1,否則s[t]=0}
10 :
Begin
t := t-1;
s[t] := ord(s[t] < s[t+1])
End;
{判前一表達式是否小於後一表達式,是則s[t]=1,否則s[t]=0}
11:
Begin
t := t-1;
s[t] := ord(s[t] >= s[t+1])
End;
{判前一表達式是否大於或等於後一表達式,是則s[t]=1,否則s[t]=0}
12 :
Begin
t := t-1;
s[t] := ord(s[t] > s[t+1])
End;
{判前一表達式是否大於後一表達式,是則s[t]=1,否則s[t]=0}
13 :
Begin
t := t-1;
s[t] := ord(s[t] <= s[t+1])
End;
{判前一表達式是否小於或等於後一表達式,是則s[t]=1,否則s[t]=0}
End;
lod :
Begin {當前指令是取變量指令(lod, l, a)}
t := t + 1;
s[t] := s[base(l) + a]
{棧頂指針加1, 根據靜態鏈SL,將層差爲l,
相對地址爲a的變量值取到棧頂}
End;
sto :
Begin {當前指令是保存變量值(sto, l, a)指令}
s[base(l) + a] := s[t];
writeln(s[t]);
writeln(fout, s[t]);
{根據靜態鏈SL,將棧頂的值存入層差爲l,
相對地址爲a的變量中}
t := t-1 {棧頂指針減1}
End;
cal :
Begin {當前指令是(cal, l, a)}
{爲被調用過程數據空間建立連接數據}
s[t+1] := base( l );
{根據層差l找到本過程的靜態直接外層過程的數據空間的SL單元,
將其地址存入本過程新的數據空間的SL單元}
s[t+2] := b; {調用過程的數據空間的起始地址存入本過程DL單元}
s[t+3] := p; {調用過程cal指令的下一條的地址存入本過程RA單元}
b := t+1; {b指向被調用過程新的數據空間起始地址}
p := a {指令地址寄存儲器指向被調用過程的地址a}
End;
int : t := t + a;
{若當前指令是(int, 0, a), 則數據空間棧頂留出a大小的空間}
jmp : p := a;
{若當前指令是(jmp, 0, a), 則程序轉到地址a執行}
jpc :
Begin {當前指令是(jpc, 0, a)}
If s[t] = 0 Then p := a;
{如果當前運算結果爲“假”(0),程序轉到地址a執行,否則順序執行}
t := t-1 {數據棧頂指針減1}
End;
red :
Begin {當前指令是red}
writeln('Input an integer: ');
readln(s[base(l)+a]); {讀一行數據,讀入到層差爲l,相對地址爲a的變量值}
writeln('Input: ', s[base(l)+a]);
writeln(fout, 'Input: ', s[base(l)+a]);
End;
wrt :
Begin {當前指令是wrt}
writeln('Output: ', s[t]);
writeln(fout, 'Output: ', s[t]);
t := t+1 {數據棧頂指針加1}
End
End {with, case}
Until p = 0;
{程序一直執行到p取最外層主程序的返回地址0時爲止}
write('End PL/0');
write(fout, 'End PL/0');
End {interpret};
Begin {主程序}
writeln('Input PL0 src file name: ');
readln(srcfile);
assign(fin, srcfile); {將文件名字符串str賦給文件變量fin,
程序對文件變量fin的操作代替對文件str的操作}
reset(fin); {打開文件}
writeln('Input dst file name: ');
readln(dstfile);
assign(fout, dstfile);
rewrite(fout); {新建文件(如果文件已經存在則沖掉)}
For ch := 'a' To ';' Do ssym[ch] := nul;
{ASCII碼的順序}
{注意前面(二分查找)找關鍵字是按ASCII碼順序來找的,
所以下面的關鍵字必須是ASCII碼的順序}
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;
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 ';
mnemonic[red] := ' RED ';
mnemonic[wrt] := ' WRT ';
{中間代碼指令的字符串}
declbegsys := [constsym, varsym, procsym];
{說明語句的開始符號}
statbegsys := [beginsym, callsym, ifsym, whilesym];
{語句的開始符號}
facbegsys := [ident, number, lparen];
{因子的開始符號}
// page(output);
err := 0; {發現錯誤的個數}
cc := 0; {當前行中輸入字符的指針}
cx := 0; {代碼數組的當前指針}
ll := 0; {輸入當前行的長度}
ch := ' '; {當前輸入的字符}
kk := al; {標識符的長度}
getsym; {取下一個記號}
block(0, 0, [period]+declbegsys+statbegsys); {處理程序體}
If sym <> period Then error(9);
{如果當前記號不是句號, 則出錯}
If err = 0 Then interpret
{如果編譯無錯誤, 則解釋執行中間代碼}
Else
Begin
write('ERRORS In PL/0 Program');
write(fout, 'ERRORS In PL/0 Program');
End;
writeln;
close(fin);
readln(srcfile);
close(fout);
End.