PL/0语言编译程序整理实现:（8）、代码执行

来源：互联网发布：网络机顶盒怎么刷机编辑：程序博客网时间：2024/05/22 12:21

unit uInterpret;

interface

uses

SysUtils,classes,Dialogs,uCodeType;

type

TInterpret = class

private

FCode: PInstructions; //--代码段

FOutList: TStrings;

public

constructor Create(pCode: PInstructions; AList: TStrings);

//---

procedure Exec;

end;

implementation

constructor TInterpret.Create(pCode: PInstructions; AList: TStrings);

begin

FCode := pCode;

FOutList := AList;

end;

procedure TInterpret.Exec;

{

栈是一种数据结构，是只能在某一端插入和删除的特殊线性表。

它按照后进先出的原则存储数据，先进入的数据被压入栈底，最后的数据在栈顶，

需要读数据的时候从栈顶开始弹出数据（最后一个数据被第一个读出来）。

}

const

CNT_DataStackSize = 500;

type

TDataStack = array[1..CNT_DataStackSize] of integer;

const

SL = 1; //--静态链：指向定义该过程的直接外过程（或主程序）运行时最新数据段的基地址。

DL = 2; //--动态链：指向调用该过程前正在运行过程的数据段基地址。

RA = 3; //--返回地址：记录调用该过程时目标程序的断点，即当时的程序地址寄存器P的值

var

S: TDataStack; //--数据栈

//---

P: integer; //--寄存器(程序地址)，指向下一条要运行的代码

I: TInstruction; //--寄存器(指令)，存放当前运行的指令

B: integer; //--寄存器(基址), 过程自身局部变量在数据栈中的起始地址

T: integer; //--寄存器(栈顶)，指向数据栈的终止地址

//---

function _Read: integer;

begin

Result := StrToIntDef(InputBox('输入', '值：', ''),0);

FOutList.Add(format('输入：%d', [Result]));

end;

//---

procedure _Write(AValue: integer);

begin

FOutList.Add(format('输出：%d', [AValue]));

end;

//---

procedure _Writeln;

begin

FOutList.Add('');

end;

//---初始化寄存器状态

procedure _InitRegister;

begin

T := 0; //--程序开始运行时,栈顶寄存器置0

B := low(S); //--数据栈基址为1

P := 0; //--从0号代码开始执行

end;

//---初始化数据段

procedure _InitDataStack;

begin

S[SL] := 0; //---主程序的SL,DL,RA三个单元均为0

S[DL] := 0;

S[RA] := 0;

end;

//---获取一行目标代码

function _GetInstruction: TInstruction;

begin

Result := FCode[P];

P := P + 1;

end;

//---lit指令:lit 0, a 读取常量a

procedure _ExecInstruction_lit;

begin

T := T + 1;

S[T] := I.Address; //--把常量值放到数据栈栈顶

end;

//---opr指令:opr 0, a 执行操作a

procedure _ExecInstruction_opr;

//---从子过程返回, 还原寄存器状态

procedure _Exec_opr_0;

begin

T := B - 1; //--恢复栈顶寄存器，即释放这段子过程占用的数据内存空间

P := S[T + RA]; //--恢复程序地址寄存器，指向调用前的子过程的代码执行位置

B := S[T + DL] //--恢复基址寄存器，指向调用前的子过程的数据段基址

end;

//---栈顶数据取反

procedure _Exec_opr_1;

begin

S[T] := -S[T];

end;

//---栈顶数据相加

procedure _Exec_opr_2;

begin

T := T - 1;

S[T] := S[T] + S[T + 1];

end;

//---栈顶数据相减

procedure _Exec_opr_3;

begin

T := T - 1;

S[T] := S[T] - S[T + 1];

end;

//---栈顶数据相乘

procedure _Exec_opr_4;

begin

t := t - 1; //--栈顶指针下移

S[t] := S[t] * S[t + 1] //--把两单元数据相乘存入栈顶

end;

//---栈顶数据相除

procedure _Exec_opr_5;

begin

t := t - 1; //--栈顶指针下移

S[t] := S[t] div S[t + 1] //--把两单元数据相整除存入栈顶

end;

//---判断奇偶

procedure _Exec_opr_6;

begin

S[t] := ord(odd(S[t])); //--数据栈顶的值是奇数则把栈顶值置1，否则置0

end;

//---栈顶数据相等

procedure _Exec_opr_8;

begin

T := T - 1;

S[T] := ORD(S[T] = S[T + 1]) //--相等置1，不等置0

end;

//---栈顶数据不等

procedure _Exec_opr_9;

begin

T := T - 1;

S[T] := ORD(S[T] <> S[T + 1]) //--不等置1，相等置0

end;

//---栈顶数据小于

procedure _Exec_opr_10;

begin

T := T - 1;

S[T] := ORD(S[T] < S[T + 1]) //--如果下面的值小于上面的值置1，否则置0

end;

//---栈顶数据大于等于

procedure _Exec_opr_11;

begin

T := T - 1;

S[T] := ORD(S[T] >= S[T + 1]) //--如果下面的值大于等于上面的值置1，否则置0

end;

//---栈顶数据大于

procedure _Exec_opr_12;

begin

T := T - 1;

S[T] := ORD(S[T] > S[T + 1]) //--如果下面的值大于上面的值置1，否则置0

end;

//---栈顶数据小于等于

procedure _Exec_opr_13;

begin

T := T - 1;

S[T] := ORD(S[T] <= S[T + 1]) //--如果下面的值小于等于上面的值置1，否则置0

end;

//---栈顶数据输出

procedure _Exec_opr_14;

begin

_Write(S[T]);

T := T - 1;

end;

//---输出"换行"

procedure _Exec_opr_15;

begin

_Writeln;

end;

//---输入操作

procedure _Exec_opr_16;

begin

T := T + 1;

S[T] := _Read;

end;

begin

case I.Address of

0: _Exec_opr_0;

1: _Exec_opr_1;

2: _Exec_opr_2;

3: _Exec_opr_3;

4: _Exec_opr_4;

5: _Exec_opr_5;

6: _Exec_opr_6;

8: _Exec_opr_8;

9: _Exec_opr_9;

10: _Exec_opr_10;

11: _Exec_opr_11;

12: _Exec_opr_12;

13: _Exec_opr_13;

14: _Exec_opr_14;

15: _Exec_opr_15;

16: _Exec_opr_16;

end;

//---通过静态链求出数据区基地址;ALevel:要求的数据区所在层与当前层的层差

function _Base(ALevel: integer): integer;

var

b1: integer;

begin

b1 := B;

while ALevel > 0 do

begin

b1 := S[b1]; //--用当前层数据区基址中的内容（正好是静态链SL数据，存放了上一层的基址）的作为新的当前层，即向上找了一层

ALevel := ALevel - 1;

end;

//---

Result := b1;

end;

//---lod指令:lod l, a 读取变量a

procedure _ExecInstruction_lod;

begin

T := T + 1;

S[T] := S[_Base(I.Level) + I.Address - 1]; //--通过数据区层差Level和偏移地址Address找到变量的数据，存入栈顶

end;

//---sto指令:sto l, a 保存变量a

procedure _ExecInstruction_sto;

begin

S[_Base(I.Level) + I.Address - 1] := S[T]; //--把栈顶的值存入位置在数据区"层差Level、偏移地址Address"的变量内存中

T := T - 1;

end;

//---cal指令:cal l, a 调用过程

procedure _ExecInstruction_cal;

begin

S[T + SL] := _BASE(I.Level); //--在栈顶压入静态链SL

S[T + DL] := B; //--然后压入当前数据区基址，作为动态链DL

S[T + RA] := P; //--最后压入当前的断点，作为返回地址RA

//--以上的工作即为过程调用前的保护现场

B := T + SL; //--把当前数据区基址指向SL所在位置

P := I.Address; //--从A所指位置开始继续执行指令，即实现了程序执行的跳转

end;

//---int指令:int 0, a 分配a个空间

procedure _ExecInstruction_int;

begin

T := T + I.Address; //--栈顶上移A个空间，即开辟A个新的内存单元

end;

//---jmp指令:jmp 0, a 无条件跳转到地址a

procedure _ExecInstruction_jmp;

begin

P := I.Address;

end;

//---jpc指令:jpc 0, a 条件跳转到地址a

procedure _ExecInstruction_jpc;

begin

if S[T] = 0 then //--判断栈顶值，如果是0就跳转，否则不跳转

P := I.Address;

T := T - 1;

end;

begin

_InitRegister;

_InitDataStack;

//---运行目标代码

repeat

I := _GetInstruction; //--获取一行目标代码

//---

case I.IType of

lit: _ExecInstruction_lit;

opr: _ExecInstruction_opr;

lod: _ExecInstruction_lod;

sto: _ExecInstruction_sto;

cal: _ExecInstruction_cal;

int: _ExecInstruction_int;

jmp: _ExecInstruction_jmp;

jpc: _ExecInstruction_jpc;

end;

until P = 0; //--如果p等于0，意味着在主程序运行时遇到了从子程序返回指令，也就是整个程序运行的结束

end;

end.