📄 machine_src.htm
字号:
{=====================================================================}
{ 判断栈顶依次存放的两个元素是否相等，将布尔型的结果置于栈顶 }
procedure <a
name="notequal">notequal</a>;
begin
s:=s-1;
st[s]:=ord(st[s]<>st[s+1]);
p:=p+1;
end;
{=======================================================================}
{ 判断栈顶依次存放的两个元素的大小，将布尔型的结果置于栈顶 }
procedure <a
name="notless">notless</a>;
begin
s:=s-1;
st[s]:=ord(st[s]>=st[s+1]);
p:=p+1;
end;
{=====================================================================}
{ 读入一个数，置于栈顶存放的地址处 }
procedure <a
name="readx">readx</a>;
begin
read(st[st[s]]);
s:=s-1;
p:=p+1;
end;
{====================================================================}
{ 将栈顶元素的值输出 }
procedure <a
name="writeintx">writeintx</a>;
begin
write(st[s]:6);
writeln;
s:=s-1;
p:=p+1;
end;
{======================================================================}
{ 将栈顶元素的值以布尔型输出 }
procedure <a
name="writebooleanx">writebooleanx</a>;
begin
if st[s]=1 then write('true')
else write('false');
writeln;
s:=s-1;
p:=p+1;
end;
{====================================================================}
{ <a
target=ff2 href="machine_note.htm#proccall说明">说明</a>，<a
target=ff2 href="machine_note.htm#过程例子">示例</a> }
procedure <a
name="proccall">proccall</a>(level,displ:integer);
var
x:integer;
begin
s:=s+1;
x:=b;
while level>0 do begin
x:=st[x];
level:=level-1;
end;
st[s]:=x;
st[s+1]:=b;
st[s+2]:=p+3;
b:=s;
s:=b+2;
p:=p+displ;
end;
{======================================================================}
{ 执行这条命令时，需要在栈顶预先放置一个地址和若干个数值，这条命令将这些数值赋值给这个地址开始的
一串地址空间中。其中，length就是数值的个数。 }
{ <a
target=ff2 href="machine_note.htm#赋值与数组例子">示例</a> }
procedure <a
name="assigm">assigm</a>(length:integer);
var
x,y,i:integer;
begin
s:=s-length-1;
x:=st[s+1];
y:=s+2;
i:=0;
while i<length do begin
st[x+i]:=st[y+i];
i:=i+1;
end;
p:=p+2;
end;
{======================================================================}
{ 栈顶为假，则转移；否则，继续向下执行。}
Procedure <a
name="Dox">Dox</a>(Displ:integer);
begin
if St[s]=ord(true) then p:=p+2 else p:=p+Displ;
s:=s-1;
end;
{ 无条件跳转 }
Procedure <a
name="Gotox">Gotox</a>(Displ:integer);
begin
p:=p+displ;
end;
{<a
target=ff2 href="machine_note.htm#procedurex说明">说明</a>，<a
target=ff2 href="machine_note.htm#过程例子">示例</a>}
procedure <a
name="Procedurex">Procedurex</a>(Varlength,TempLength,Displ,LineNo:integer);
begin
s:=s+VarLength;
if s+TempLength>Max then Error(LineNo,'Stack limit') else
p:=p+Displ;
end;
{<a
target=ff2 href="machine_note.htm#endproc说明">说明</a>，<a
target=ff2 href="machine_note.htm#过程例子">示例</a>}
procedure <a
name="EndProc">EndProc</a>(ParamLength:integer);
begin
s:=b-ParamLength-1;
p:=St[b+2];
b:=St[b+1];
end;
{ <a
target=ff2 href="machine_note.htm#programx说明">说明</a> }
procedure <a
name="Programx">Programx</a>(VarLength,TempLength,Displ,Lineno:integer);
begin
b:=StackBottom;
s:=b+2+varLength;
if s+TempLength>Max then
Error(LineNo,'Stack Limit')
else
p:=p+Displ;
end;
{程序结束指令}
Procedure <a
name="EndProg">EndProg</a>;
begin
running:=false;
end;
<!--/font--></pre>
<pre><!--font style="font-family: 宋体; font-size: -13pt" size="3"-->{ 接下来的指令都是优化指令 }
{ localvar(displ) = variable(0,displ) }
Procedure localvar(Displ:integer);
begin
s:=s+1;
St[s]:=b+Displ;
p:=p+2;
end;
{ localvalue(displ) = localvar(displ) value(1) }
Procedure LocalValue(Displ:integer);
begin
s:=s+1;
St[s]:=St[b+Displ];
p:=p+2;
end;
{ Globalvalue(displ) = variable(1,displ) }
procedure GlobalValue(Displ:integer);
begin
s:=s+1;
St[s]:=St[St[b]+Displ];
p:=p+2;
end;
{ Globalvar(displ) = Globalvalue(displ) value(1) }
procedure Globalvar(Displ:integer);
begin
s:=s+1;
St[s]:=St[b]+Displ;
p:=p+2;
end;
{ SimpleValue=Value(1) }
procedure SimpleValue;
begin
St[s]:=St[St[s]];
p:=p+1;
end;
{ SimpleAssign=Assign(1) }
procedure SimpleAssign;
begin
St[St[s-1]]:=St[s];
s:=s-2;
p:=p+1;
end;
{ LocalCall(Displ)=ProcCall(0,Displ) }
procedure LocalCall(displ:integer);
begin
St[s+1]:=b;
St[s+2]:=b;
St[s+3]:=p+2;
b:=s+1;
s:=b+2;
p:=p+Displ;
end;
{ GlobalCall(Displ)=ProcCall(1,Displ) }
procedure GlobalCall(displ:integer);
begin
St[s+1]:=St[b];
St[s+2]:=b;
St[s+3]:=p+2;
b:=s+1;
s:=b+2;
p:=p+Displ;
end;
procedure runprogram;
var
op:integer;
begin
running:=true;
p:=min;
while running do
begin
op:=St[p];
case op of
0:add;
1:andx;
2:assigm(St[p+1]);
3:constant(St[p+1]);
4:divide;
5:dox(St[p+1]);
6:endproc(St[P+1]);
7:endprog;
9:equal;
10:field(St[p+1]);
11:greater;
12:gotox(St[p+1]);
13:index(St[p+1],St[p+2],St[p+3],St[p+4]);
14:less;
15:minus;
16:modulo;
17:multiply;
18:notequal;
19:notgreater;
20:notless;
21:notx;
22:orx;
23:proccall(St[p+1],St[p+2]);
24:procedurex(St[p+1],St[p+2],St[p+3],St[p+4]);
25:programx(St[p+1],St[p+2],St[p+3],St[p+4]);
26:readx;
27:subtract;
28:value(St[p+1]);
29:variable(St[p+1],St[p+2]);
30:varparam(St[p+1],St[p+2]);
31:writeintx;
32:writebooleanx;
33:localvar(st[p+1]);
34:localvalue(st[p+1]);
35:globalvar(st[p+1]);
36:globalvalue(st[p+1]);
37:simplevalue;
38:simpleassign;
39:globalcall(st[p+1]);
40:localcall(st[p+1]);
end;
end;
end;
{ 装入程序 }
procedure loadprogram;
var
x:integer;
begin
x:=min;
while not eof(obj_f) do
begin
read(obj_f,St[x]);
x:=x+1;
end;
stackbottom:=x;
end;
begin
write('please enter obj_filename:');
readln(filename);
assign(obj_f,filename);
reset(obj_f);
loadprogram;
close(obj_f);
runprogram;
end.
<!--/font--></pre>
</body>
</html>
<html><script language="JavaScript">⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -