Listing COMPILAT.PAS
Program compilator;
{ Rezolvare de Mihai Scortaru }
{ Liceul de Informatica, Cluj }
type
eticheta=record
nume:string[7];
loc:Word
end;
var
pr:array[1..1024] of string[25];
mem:array[1..1024] of Byte;
ne,m,n:Byte;
et:array[1..1024] of eticheta;
poz:array[1..1024] of Word;
f,g:Text;
p:Word;
s1:string[25];
procedure citire;
var x:Char;
i:Byte;
begin
Assign(f,'PROGRAM.IN');
Reset(f);
n:=0;
while not Seekeof(f) do
begin
Inc(n);
Readln(f,pr[N])
end;
Close(f);
Assign(g,'PROGRAM.OUT');
ReWrite(g)
end;
procedure punenumere;
var i,x,buc:Byte;
begin
x:=0;
buc:=0;
i:=1;
while s1[i]<>'(' do
begin
x:=x*10+Ord(s1[i])-48;
Inc(i)
end;
Inc(i);
while s1[i]<>')' do
begin
buc:=buc*10+Ord(s1[i])-48;
Inc(i)
end;
for i:=m+1 to m+buc do
mem[i]:=x;
Inc(m,buc)
end;
procedure punecar;
var x:Char;
i,buc:Byte;
begin
x:=s1[2];
i:=5;
buc:=0;
while s1[i]<>')' do
begin
buc:=buc*10+Ord(s1[i])-48;
Inc(i)
end;
for i:=m+1 to m+buc do
mem[i]:=Ord(x);
Inc(m,buc)
end;
procedure punesir;
var i:Byte;
begin
i:=2;
while s1[i]<>'"' do
begin
Inc(m);
mem[m]:=Ord(s1[i]);
Inc(i)
end;
end;
procedure puneadr;
begin
Inc(m,1)
end;
procedure puneval;
begin
Inc(m,2)
end;
procedure prelucrare1;
var i,j,ap,gh:Byte;
begin
for i:=1 to n do
begin
s1:='';
ap:=0;
gh:=0;
for j:=1 to Length(pr[i]) do
begin
if pr[i][j]='''' then Inc(ap);
if pr[i][j]='"' then Inc(gh);
if pr[i][j]<>' '
then s1:=s1+pr[i][j]
else if Odd(ap) or Odd(gh)
then s1:=s1+pr[i][j]
end;
if Pos(':',s1)<>0
then
begin
Inc(ne);
et[ne].loc:=m+1;
et[ne].nume:=Copy(s1,1,Pos(':',s1)-1);
Delete(s1,1,Pos(':',s1))
end;
pr[i]:=s1;
poz[i]:=m+1;
case s1[1] of
'0'..'9':punenumere;
'''':punecar;
'"':punesir;
'[':puneadr;
'<':puneval
end
end
end;
procedure puneadr2;
var etc:string;
i:Byte;
begin
i:=2;
etc:='';
while s1[i]<>'>' do
begin
etc:=etc+s1[i]; Inc(i)
end;
for i:=1 to ne do
if et[i].nume=etc
then
begin
mem[p]:=et[i].loc mod 256;
mem[p+1]:=et[i].loc div 256;
Break
end
end;
procedure puneval2;
var etc:string;
i:Byte;
begin
i:=2;
etc:='';
while s1[i]<>']' do
begin
etc:=etc+s1[i];
Inc(i)
end;
for i:=1 to ne do
if et[i].nume=etc
then
begin
mem[p]:=mem[et[i].loc];
Break
end
end;
procedure prelucrare2;
var i:Byte;
begin
for i:=1 to n do
begin
s1:=pr[i];
p:=poz[i];
if pr[i,1]='<' then puneadr2
end;
for i:=1 to n do
begin
s1:=pr[i];
p:=poz[i];
if pr[i,1]='[' then puneval2
end
end;
procedure scrie_rezultate;
var i:Word;
begin
for i:=1 to m do
begin
Write(g,mem[i],' ');
Write(mem[i],' ')
end;
Close(g)
end;
Begin
citire;
ne:=0;
prelucrare1;
prelucrare2;
scrie_rezultate
End.