const
cxmax=100;
(* opcodes *)
lit=1; opr=2; lod=3; sto=4;
int=6; jmp=7;
(* opr arguments *)
neg=1; add=2; sub=3; mul=4;
divis=5; ret=0;
var
codefct: array [cxmax] of integer ;
codea: array [cxmax] of integer ;
procedure interpret;
const stacksize=200;
var
p,b,t: integer ;
ifct, ia: integer ;
s: array [stacksize] of integer ;
begin
writeln ("start pl/0");
t:=0; b:=1; p:=0;
s[0]:=0;
s[1]:=0; s[2]:=0; s[3]:=0;
repeat
ifct:=codefct[p];
ia:=codea[p];
p:=p + 1;
case ifct of
lit:
begin
t:=t + 1;
s[t]:=ia;
end ;
opr:
case ia of (* operator *)
ret:
begin
t:=b - 1;
p:=s[t + 3];
b:=s[t + 2];
end ;
neg:
s[t]:=- s[t];
add:
begin
t:=t - 1;
s[t]:=s[t] + s[t + 1];
end ;
sub:
begin
t:=t - 1;
s[t]:=s[t] - s[t + 1];
end ;
mul:
begin
t:=t - 1;
s[t]:=s[t] * s[t + 1];
end ;
divis:
begin
t:=t - 1;
s[t]:=s[t] div s[t + 1];
end
end ; (* end case ia of *)
lod:
begin
t:=t + 1;
s[t] := s[1 + ia];
end ;
sto:
begin
s[1 + ia] := s[t];
writeln ("> ",s[t]);
t:=t - 1;
end ;
int:
t:=t + ia;
jmp:
p:=ia
end ;
until p=0;
writeln ("end pl/0")
end ;
begin
codefct[0]:=jmp; codea[0]:=1;
codefct[1]:=int; codea[1]:=5;
codefct[2]:=lit; codea[2]:=3;
codefct[3]:=sto; codea[3]:=3;
codefct[4]:=lit; codea[4]:=3;
codefct[5]:=sto; codea[5]:=4;
codefct[6]:=lit; codea[6]:=5;
codefct[7]:=lit; codea[7]:=2;
codefct[8]:=lod; codea[8]:=3;
codefct[9]:=opr; codea[9]:=add;
codefct[10]:=lit; codea[10]:=4;
codefct[11]:=opr; codea[11]:=mul;
codefct[12]:=opr; codea[12]:=add;
codefct[13]:=sto; codea[13]:=3;
codefct[14]:=lit; codea[14]:=4;
codefct[15]:=lit; codea[15]:=2;
codefct[16]:=lod; codea[16]:=3;
codefct[17]:=opr; codea[17]:=add;
codefct[18]:=opr; codea[18]:=mul;
codefct[19]:=lit; codea[19]:=5;
codefct[20]:=opr; codea[20]:=add;
codefct[21]:=sto; codea[21]:=3;
codefct[22]:=lod; codea[22]:=3;
codefct[23]:=lod; codea[23]:=4;
codefct[24]:=opr; codea[24]:=sub;
codefct[25]:=sto; codea[25]:=4;
codefct[26]:=opr; codea[26]:=ret;
interpret;
end .
