原理实验讲义pl0编译程序

programPL0(file1,{label99;}norw=txmax=nmax=al=amax=levmax=cxmax=200;symbol=(nul,ident,number,plus,minus,times,slash,oddsym,eql,neq,lss,leq,gtr,geq,lparen,rparen,comma,semicolon, es,beginsym,endsym,ifsym,thensym,whilesym,writesym,readsym,dosym,callsym,constsym,varsym,procsym);alfa=packedarray[1..al]ofchar;object_my=(constant,variable,procedure_my);symset=setofsymbol;fct=(lit,opr,lod,sto,cal,int,jmp,jpc);{functions}instruction=packedrecordf:l:a:0..amax;{LIT0,aOPRLODl,aSTOl,aCALl,aINT0,aJMP0,aJPC0,afile2,file3:text;ch:sym:symbol;id:alfa;num:integer;cc:integer;ll:kk,err:integer;cx:integer;line:array[1..81]ofchar;a:alfa;code:array[0..cxmax]ofinstruction;word:array[1..norw]ofalfa;wsym:array[1..norw]ofsymbol;ssym:array[char]ofsymbol;mnemonic:array[fct]ofpackedarray[1..5]ofchar;declbegsys,statbegsys,facbegsys:symset;table:array[0..txmax]ofname:casekind:object_myofconstant:(val:integer);variable,procedure_my:(level,adr,size:integer)procedureerror(n:integer);wrin('****','':cc-1,'@',n:wrin(file1,'****','':cc-1,'@',n:2);err:=err+1endprocedureexitProcedure;endFile:=true;wrin;procedurevari,j,k:integer;proceduregetch;ifcc=llthenifeof(fileIn)then {Recegoto99}wrin;ll:=cc:=0;write(cx:5,'');write(file2,cx:5,'');whilenoteoln(fileIn)doll:=ll+1;read(fileIn,ch);write(file2,ch);line[ll]:=chwrin;ll:=ll+1;read(fileIn,line[ll]);read(fileIn,ch);cc:=cc+1;ch:=line[cc];end{getch};begin{getsym}whilech=''doifchin['a'..'z']thenbegink:=0;ifk<althenk:=k+a[k]:=untilnot(chin['a'..'z','0'..'9']);ifk>=kkthenkk:=ka[kk]:='';kk:=kk-untilkk=id:=i:=j:=norw;k:=(i+j)divifid<=word[k]thenj:=k-1;ifid>=word[k]theni:=k+1;untili>ifi-1>jsym:=wsym[k]sym:=ifchin['0'..'9']thenk:=num:=sym:=number;num:=10*num+(ord(ch)-ord('0'));k:=k+1;untilnot(chin['0'..'9']);ifk>nmaxthenifch=':'thenifch='='thensym:= sym:=nul;else*如果读到不是字母/数字/ifchthen**)getch;*再读一个字符ifchthen**)symleq;**)getch(*读一个字符*)else*小于号后不是跟着等号symlss(*那就是一个单独的小于号else*读到不是字母/数字/冒号/小于号ifchthen*读到大于号，则类似于处理小于号*)getch*ifchthen*读到等号*)symgeq**)getch(*读一个字符*)else*symgtr*beginsym:=ssym[ch];getchendproceduregen(x:fct;y,z:integer);ifcx>cxmaxbeginwrite('PROGRAMTOO{Recegoto99}withcode[cx]beginf:=x;l:=y;a:=zcx:=cx+1end{gen};proceduretest(s1,s2:symset;n:integer);ifnot(symins1)beginerror(n);s1:=s1+s2;whilenot(symins1)dogetsymendprocedureblock(lev,tx:integer;fsys:symset);dx:integer;tx0:integer;cx0:procedureenter(k:object_my);tx:=txwithtable[tx]beginname:=id;kind:=k;casekofconstant:ifnum>amaxbeginerror(31);num:=0end;val:=numvariable:level:=lev;adr:=dx;dx:=dx+1;procedure_my:level:=levendfunctionposition(id:alfa):integer;vari:integer;table[0].name:=id;i:=whiletable[i].name<>iddoi:=i-position:=endprocedureconstdeclaration;ifsym=identthenbegingetsym;ifsymin[eql, es]thenifsym= esthenerror(1);ifsym=numberbeginenter(constant);getsymelseerror(2)endelseerror(3)endelseendprocedurevardeclaration;ifsym=identbeginenter(variable);getsymendelseerror(4)endprocedurelistcode;vari:integer;iflistswitchthen**)fori:=cx0tocx-1dowithcode[i]dowrin(i:4,mnemonic[f]:5,l:3,a:wrin(file1,i:4,mnemonic[f]:5,l:3,a:5)endprocedurestatement(fsys:symset);vari,cx1,cx2:integer;procedureexpression(fsys:varaddop:symbol;procedureterm(fsys:symset);varmulop:procedurefactor(fsys:symset);vari:integer;begintest(facbegsys,fsys,24);whilesyminfacbegsysdoifsym=identtheni:=ifi=0thenerror(11)elsewithtable[i]docasekindconstant:gen(lit,0,val);variable:gen(lod,lev-level,adr);procedure_my:error(21)endifsym=numberthenifnum>amaxbeginerror(31);num:=0end;gen(lit,0,num);getsymendifsym=lparenthenbegingetsym;ifsym=rparenthengetsymelseerror(22)test(fsys,facbegsys,23)endbegin{term}factor(fsys+[times,slash]);whilesymin[times,slash]domulop:=sym;getsym;factor(fsys+[times,slash]);ifmulop=timesthengen(opr,0,elsegen(opr,0,end{term};begin{expression}ifsymin[plus,minus]thenaddop:=sym;getsym;term(fsys+[plus,minus]);ifaddop=minusthengen(opr,0,1)endelseterm(fsys+[plus,minus]);whilesymin[plus,minus]doaddop:=sym;getsym;term(fsys+[plus,minus]);ifaddop=plusthengen(opr,0,elsegen(opr,0,endprocedurecondition(fsys:symset);varrelop:symbol;ifsym=oddsymthengetsym;expression(fsys);gen(opr,0,6)endelseexpression([eql,neq,lss,gtr,leq,geq]+fsys);ifnot(symin[eql,neq,lss,leq,gtr,geq])error(20)elserelop:=sym;getsym;expression(fsys);caserelopofeql:gen(opr,0,neq:gen(opr,0,lss:gen(opr,0,geq:gen(opr,0,gtr:gen(opr,0,leq:gen(opr,0,13);end{condition};begin{statement}ifsym=identthenbegini:=position(id);ifi=0thenerror(11)iftable[i].kind<>variablethenbeginerror(12);i:=0;end;ifsym= esthengetsymelseerror(13);ifi<>0withtable[i]dogen(sto,lev-level,adr)endelseifsymreadsymthen(*read语句getsym*获得下一tokenifsymlparenthen*如果read语句后跟的不是左括号*)error(34)(*34号错误*)repeat(*循环得到read语句括号中的参数表，依次产生相应的“从键盘读入”目标代码*)getsym*获得一个token，正常应是一个变量名*)ifsym=identthen(*如果确为一个标识符*)(*这里略有问题，还应判断一下这个标识符是不是变量名，如果是常量名或过程名应出错*)iposition(id)(*查符号表，找到它所在位置给i，找不到时i会为0*)i0*不是标识符则有问题，i0作出错标志*)ifi=0then(*如果有错误*)error(35)(*抛出35号错误*)else(**)withtable[i]dogen(opr016*生成指令:从键盘读入数字gen(sto,levleveladr*生成sto指令，把读入的值存入指定变量所在的空间*)getsym(*获取下一个token，如果是逗号，则read语还没完，否则应当是右括号*)untilsym<>(*不断生成代码直到read语句的参数表中的变量遍历完为止，这里遇到不是逗号，应为右括号ifsymrparenthen(**)error(33);(*抛出33号错误whilenotsyminfsysdo(*依靠fsys集，找到下一个合法的token，恢复语法分析*)getsym*read语句正常结束，得到下一个一般为分号或endifsymwritesymthen*如果遇到了write语句getsym*获取下一token*)ifsym=lparenthen(*如确为左括号*)repeat(*依次获取括号中的每一个值，进行输出*)getsym*获得一个token*)expression([rparen,comma]+(*调用expression用于出错恢复的集合中加上右括号和逗号gen(opr0,14)*14号指令：向屏幕输出*)untilsym<>comma;(*循环直到遇到的不再是逗号，ifsymrparenthen**)error(33)(*33号错误*)getsym(*获取下一个token，为后面分析作准备gen(opr0,15)(*生成15号操作指令：输出一个换行*)(*由此可知PL/0write语句与Pascal中的wrin*)ifsym=callsymthenbegingetsym;ifsym<>identthenerror(14)elsei:=ifi=0thenerror(11)elsewithtable[i]doifkind=procedure_mythengen(cal,lev-level,adr)elseerror(15);endelseifsym=ifsymgetsym;condition([thensym,dosym]+fsys);ifsym=thensymthengetsymelseerror(16);cx1:=cx;gen(jpc,0,0);statement(fsys);code[cx1].a:=cxendelseifsym=beginsymthengetsym;statement([semicolon,endsym]+fsys);whilesymin[semicolon]+statbegsysdoifsym=semicolonthengetsymelseerror(10);statement([semicolon,endsym]+fsys)ifsym=endsymthengetsymelseerror(17)endelseifsym=whilesymthencx1:=cx;getsym;condition([dosym]+fsys);cx2:=cx;gen(jpc,0,0);ifsym=dosymthengetsymelseerror(18);statement(fsys);gen(jmp,0,cx1);code[cx2].a:=cxtest(fsys,[],19)end{statement};begindx:=3;tx0:=tx;table[tx].adr:=cx;gen(jmp,0,0);iflev>levmaxthenerror(32);ifsym=constsymthenbegingetsym;whilesym=commabegingetsym;constdeclarationifsym=semicolonthengetsymelseerror(5)untilsym<>identifsym=varsymthenbegingetsym;whilesym=commabegingetsym;vardeclarationifsym=semicolonthengetsymelseerror(5)untilsym<>ident;whilesym=procsymdobegingetsym;ifsym=identbeginenter(procedure_my);getsymendelseerror(4);ifsym=semicolonthengetsymelseerror(5);block(lev+1,tx,[semicolon]+fsys);ifsym=semicolonthenbegingetsym;test(statbegsys+[ident,procsym],fsys,6)elseerror(5)test(statbegsys+[ident],declbegsys,7)untilnot(symindeclbegsys);code[table[tx0].adr].a:=cx;withtable[tx0]beginadr:=cx;size:=dx;cx0:=cx;gen(int,0,dx);statement([semicolon,endsym]+fsys);gen(opr,0,0);test(fsys,[],8);end{block};procedureconststacksize=500;varp,b,t:integer;i:s:array[1..stacksize]ofinteger;functionbase(l:integer):integer;varb1:integer;b1:=b;whilel>0dobeginb1:=s[b1];l:=l-1end;base:=b1endbeginwrin('STARTPL/0');t:=0;b:=1;p:=0;s[1]:=0;s[2]:=0;s[3]:=i:=code[p];p:=p+1;withidocasefoflit:begint:=t+1;s[t]:=aopr:casea:t:=b-1;p:=s[t+3];b:=:s[t]:=-:t:=t-1;s[t]:=s[t]-s[t+1]:t:=t-1;s[t]:=s[t]-s[t+1]:t:=t-1;s[t]:=s[t]*s[t+1]:t:=t-1;s[t]:=s[t]divs[t+1]:s[t]:=ord(odd(s[t]));8:begint:=t-1;s[t]:=ord(s[t]=s[t+1])9:begint:=t-s[t]:=ord(s[t]<>s[t+1])10:begint:=t-s[t]:=ord(s[t]<s[t+1])11:begint:=t-s[t]:=ord(s[t]>=s[t+1])12:begint:=t-s[t]:=ord(s[t]>s[t+1])13:begint:=t-s[t]:=ord(s[t]<=s[t+1])14:*14*)write(s[t]);(*输出栈顶值*)write(file3s[t**)t:=t-1(*栈顶下移*)15:*15号操作为输出换行操作*) (*输出换行wrin(file3**)16:*16号操作是接受键盘值输入到栈顶*)tt1;(**)write('?');(*屏显问号*)write(file3,'?');(* (*获得输入wrin(file3,s[t]);(*把用户输入值打印到文件lod:t:=t+1;s[t]:=s[base(l)+a]sto:s[base(l)+a]:=s[t];{wrin(s[t]);}t:=t-1cal:begin{generatenewblockmark}s[t+1]:=base(l);s[t+2]:=b;s[t+3]:=p;b:=t+1;p:=aint:t:=t+a;jmp:p:=a;jpc:beginifs[t]=0thenp:=a;t:=t-1end{with,case}untilp=0;write('ENDPL/0');close(file3)*关闭用于记录屏幕输入输出的file3文件(*PCODE代码的解释执行过程结束end{interpret};forch:=''to'@'dossym[ch]:=word[1]:= ';word[2]:= word[3]:= ';word[4]:= word[5]:= ';word[6]:= word[7]:= ';word[8]:='PROCEDUREword[9]:='THEN ';word[10]:='VAR word[11]:='WHILE 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['+']:= ssym['-']:=ssym['*']:= ssym['/']:=ssym['(']:= ssym[')']:=ssym['=']:= ssym[',']:=ssym['.']:= ssym['!']:=ssym['<']:= ssym['>']:=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'; mn