Developing.ru

Код: Выделить всё

program microPascal; 
 uses SysUtils; 

 const m = 100; 

 var 
 fin,fout: TextFile; 

 h: array[1..m] of record Info: string[8]; LLink,RLink: Integer end; 
 Avail: Integer; 
 Lex: string[8]; 
 cLex: Integer; 
 pt: Integer; 
 ch: Char; 

 procedure Error(errCode: Integer); 
 begin 
 WriteLn(fout); 
 Write(fout,'ERROR: '); 
 case errCode of 
 1: WriteLn(fout,'End of input before logical end of program.'); 
 2: WriteLn(fout,'Unknown symbol.'); 
 3: WriteLn(fout,'Must be "id" or "(".'); 
 4: WriteLn(fout,'Must be ")".'); 
 5: WriteLn(fout,'Must be "=".'); 
 end; // case 
 CloseFile(fin); 
 CloseFile(fout); 
 Halt; 
 end; // Error 

 procedure getCh; 
 begin 
 if Eof(fin) then Error(1); 
 Read(fin,ch); 
 Write(fout,ch); 
 end; // getCh 

 procedure getLex; 
 var z: Integer; 
 begin 

 while ch = ' ' do getCh; 

 Lex:=ch; 
 case ch of 
 'a'..'z','A'..'Z': cLex:=1; 
 '+': cLex:=3; 
 '*': cLex:=4; 
 '(': cLex:=5; 
 ')': cLex:=6; 
 '=': cLex:=7; 
 else Error(2); 
 end; // case 

 getCh; 
 if cLex in [3..7] then Exit; 

 z:=1; 
 while ch in ['a'..'z','A'..'Z','0'..'9'] do 
 begin 
 if z < 8 then Lex := Lex + ch; 
 Inc(z); 
 getCh; 
 end; 

 end; // getLex 

 procedure E(var pt: Integer); forward; 

 procedure F(var pt: Integer); 
 var q: Integer; 
 begin 
 case cLex of 
 1: begin 
 q:=Avail; Avail:=h[q].RLink; 
 h[q].Info:=Lex; 
 h[q].LLink:=0; 
 getLex; 
 pt:=q; 
 end; 
 5: begin 
 getLex; 
 E(pt); 
 if cLex = 6 then 
 getLex 
 else 
 Error(4); 
 end; 
 else 
 Error(3); 
 end; // case 
 end; // F 

 procedure T(var pt: Integer); 
 var q: Integer; 
 begin 
 F(pt); 
 while cLex = 4 do 
 begin 
 q:=Avail; Avail:=h[q].RLink; 
 h[q].Info:=Lex; 
 h[q].LLink:=pt; 
 getLex; 
 F(h[q].RLink); 
 pt:=q; 
 end; 
 end; // T 

 procedure E(var pt: Integer); 
 var q: Integer; 
 begin 
 T(pt); 
 while cLex = 3 do 
 begin 
 q:=Avail; Avail:=h[q].RLink; 
 h[q].Info:=Lex; 
 h[q].LLink:=pt; 
 getLex; 
 T(h[q].RLink); 
 pt:=q; 
 end; 
 end; // E 

 procedure Prgm(var pt: Integer); 
 begin 
 E(pt); 
 if cLex = 7 then 
 begin 
 WriteLn(fout); 
 WriteLn(fout,'Success compilation.') 
 end 
 else 
 Error(5); 
 end; // Prgm 

 procedure printTree(pt: Integer); 
 begin 
 if h[pt].LLink = 0 then 
 WriteLn(fout,pt:3,h[pt].Info:9) 
 else 
 begin 
 WriteLn(fout,pt:3,h[pt].Info:9,h[pt].LLink:4,h[pt].RLink:4); 
 printTree(h[pt].LLink); 
 printTree(h[pt].RLink); 
 end; 
 end; // printTree 

 procedure genCode(pt,lev: Integer); 
 var mCode: string[3]; 
 begin 
 if h[pt].LLink = 0 then 
 begin 
 WriteLn(fout,' LDA ',h[pt].Info); 
 Exit; 
 end; 
 if h[pt].Info = '+' then mCode:='ADD' else mCode:='MUL'; 
 genCode(h[pt].LLink,lev+1); 
 WriteLn(fout,' STA @',lev); 
 genCode(h[pt].RLink,lev+1); 
 WriteLn(fout,' ',mCode,' @',lev); 
 end; // genCode 

 begin 
 AssignFile(fout,'output.txt'); Rewrite(fout); 
 AssignFile(fin,'input.txt'); Reset(fin); 

 for pt:=1 to m-1 do h[pt].RLink:=pt+1; 
 h[m].RLink:=0; 
 Avail:=1; 
 getCh; 
 { 
 repeat 
 getLex; 
 WriteLn(fout,cLex, ' |', Lex, '|'); 
 until cLex = 7; 
 } 
 getLex; 
 Prgm(pt); 
 WriteLn(fout); 
 WriteLn(fout,'Semantic tree:'); 
 WriteLn(fout,'pt = ',pt); 
 printTree(pt); 

 WriteLn(fout); 
 WriteLn(fout,'Program:'); 
 genCode(pt,1); 

 CloseFile(fin); 
 CloseFile(fout); 
 end.