PL0Compiler

github地址：https://github.com/wuzht/PL0Compiler

实验内容

• 在计算机上实现PL0语言的编译程序
• 扩展PL0语言的功能，并在计算机上实现

实验要做的工作

1. 找到PASCAL编译系统(Delphi系统也可以)
2. 在PASCAL系统上运行PL0编译程序,需要对PL0编译程序作一些修改、调试
3. 在PASCAL系统中，为PL0的编译程序建立输入文件和输出文件
   • 在输入文件中存放PL0源程序
   • 在输出文件中存放PL0源程序被编译后产生的中间代码和运行数据
4. PL0的编译程序运行时，通过输入文件输入PL0源程序，在输出文件中产生源程序的中间代码然后运行该中间代码，在输出文件中产生运行数据
5. 如果上述工作成功，则第一项实习任务完成.再做以下工作
6. 在PL0语言中增加Read和Write语句
7. 修改PL0编译程序, 使得PL0源程序可以使用Read和Write语句，从文件(或键盘)输入数据，并可以向文件(或屏幕)写数据
8. 若以上工作完成, 则第2项实验任务完成

编译系统

Free Pascal: https://www.freepascal.org/

编译运行截图

Part 1

Part 2

PL0源程序

Part 1

src.pas

const  m = 7, n = 85;
var  x, y, z, q, r;
procedure  multiply;
  var  a, b;
  begin  a := x;  b := y;  z := 0;
while b > 0 do
begin  
  if odd b then z := z + a;
  a := 2*a ;  b := b/2 ;
end
  end;
procedure  divide;
  var  w;
  begin  r := x;  q := 0;  w := y;
while w @ r do w := 2*w ;
while w > y do
begin  q := 2*q;  w := w/2;
  if w @ r then
  begin  r := r-w;  q := q+1 end
end
  end;
procedure  gcd;
  var  f, g ;
  begin  f := x;  g := y;
while f ! g do
begin
  if f < g then g := g-f;
  if g < f then f := f-g;
end;
z := f
  end;
begin 
  x := m;  y := n;  call multiply;
  x := 25;  y:= 3;  call divide;
  x := 84;  y := 36;  call gcd;
end.

Part 2

rwsrc.pas

var input;
begin 
  read(input);
  write(input);
end.

PL0编译程序

{PL0编译程序注释}

Program  PL0 (input, output);
{带有代码生成的PL0编译程序}

Const 
  norw = 13; {保留字的个数}
  txmax = 100; {标识符表长度}
  nmax = 14; {数字的最大位数}
  al = 10; {标识符的长度}
  amax = 2047; {最大地址}
  levmax = 3; {程序体嵌套的最大深度}
  cxmax = 200; {代码数组的大小}

Type 
  symbol = (nul, ident, number, plus, minus, times, slash, oddsym,
            eql, neq, lss, leq, gtr, geq, lparen, rparen, comma, semicolon,
            period, becomes, beginsym, endsym, ifsym, thensym,
            whilesym, dosym, callsym, constsym, varsym, procsym,
            readsym, writesym);
  alfa = packed array [1..al] Of char;
  Object2 = (constant, variable, Procedure2);
  symset = set Of symbol;
  fct = (lit, opr, lod, sto, cal, int, jmp, jpc, red, wrt); {functions}
  instruction = packed Record
    f : fct;  {功能码}
    l : 0..levmax; {相对层数}
    a : 0..amax; {相对地址}
End;

{LIT 0,a : 取常数a
OPR 0,a : 执行运算a
LOD l,a : 取层差为l的层﹑相对地址为a的变量
STO l,a : 存到层差为l的层﹑相对地址为a的变量
CAL l,a : 调用层差为l的过程
INT 0,a : t寄存器增加a
JMP 0,a : 转移到指令地址a处
JPC 0,a : 条件转移到指令地址a处 }

Var 
  ch : char; {最近读到的字符}
  sym : symbol; {最近读到的符号}
  id : alfa; {最近读到的标识符}
  num : integer; {最近读到的数}
  cc : integer; {当前行的字符计数}
  ll : integer; {当前行的长度}
  kk, err : integer;
  cx : integer; {代码数组的当前下标}
  line : array [1..81] Of char; {当前行}
  a : alfa; {当前标识符的字符串}
  code : array [0..cxmax] Of instruction; {中间代码数组}
  word : array [1..norw] Of alfa; {存放保留字的字符串}
  wsym : array [1..norw] Of symbol; {存放保留字的记号}
  ssym : array [char] Of symbol; {存放算符和标点符号的记号}
  mnemonic : array [fct] Of packed array [1..5] Of char;
  {中间代码算符的字符串}
  declbegsys, statbegsys, facbegsys : symset;
  table : array [0..txmax] Of {符号表}
    Record
      name : alfa;
      Case kind : Object2 Of constant : (val : integer);
      variable, Procedure2 : (level, adr : integer)
    End;
  fin, fout : text; {fin, fout是文本文件}
  srcfile, dstfile : string;


Procedure error (n : integer);
Begin
  writeln('****', ' ' : cc-1, '^', n : 2);
  err := err + 1
  {cc为当前行已读的字符数, n为错误号}{错误数err加1}
End {error};


Procedure getsym;
  Var  i, j, k : integer;
  Procedure  getch; {取下一字符}
  Begin If cc = ll Then {如果cc指向行末}
    Begin If eof(fin) Then {如果已到文件尾}
        Begin
          write('Program INCOMPLETE');
          writeln(fout, 'Program INCOMPLETE');
          close(fin);
          close(fout);
          // goto 99
          exit(); {相当于goto 99}
        End;
      {读新的一行}
      ll := 0;
      cc := 0;
      write(cx : 5, ' '); {cx : 5位数}
      write(fout, cx : 5, ' ');
      While not eoln(fin) Do {如果不是行末}
        Begin
          ll := ll + 1;
          read(fin, ch);
          write(ch);
          write(fout, ch);
          line[ll] := ch  {一次读一行入line}
        End;
      writeln;
      writeln(fout);
      readln(fin);
      ll := ll + 1;
      // read(line[ll])  {line[ll]中是行末符}
      line[ll] := ' '
    End;
    cc := cc + 1;
    ch := line[cc]  {ch取line中下一个字符}
  End {getch};

Begin {getsym}
  while ch = ' ' do 
    getch; {跳过无用空白}
  If ch In ['a'..'z'] Then
    Begin {标识符或保留字}
      k := 0;
      Repeat {处理字母开头的字母﹑数字串}
        If k < al Then
        Begin
          k := k + 1;
          a[k] := ch
        End;
        getch
      Until not (ch In ['a'..'z', '0'..'9']);
      If k >= kk Then 
        kk := k
      Else Repeat
        a[kk] := ' ';
        kk := kk-1  {如果标识符长度不是最大长度, 后面补空白}
      until kk = k;                
      id := a;
      i := 1;
      j := norw;
      {id中存放当前标识符或保留字的字符串}
      Repeat
        k := (i+j) Div 2; {用二分查找法在保留字表中找当前的标识符id}
        if id <= word[k] then j := k-1;  
        If id >= word[k] Then i := k+1
      Until i > j;
      If i-1 > j Then sym := wsym[k] Else sym := ident
      {如果找到, 当前记号sym为保留字, 否则sym为标识符}
    End
      
  Else If ch In ['0'..'9'] Then
    Begin {数字}
      k := 0; num := 0; sym := number; {当前记号sym为数字}
      Repeat {计算数字串的值}
        num := 10*num + (ord(ch)-ord('0'));
        {ord(ch)和ord(0)是ch和0在ASCII码中的序号}
        k := k + 1;
        getch;
      Until not (ch In ['0'..'9']); {直到输入的不是数字}
      If k > nmax Then error(30)
      {当前数字串的长度超过上界,则报告错误}
    End
      
  Else If ch = ':' Then {处理赋值号}
    Begin
      getch;
      If ch = '=' Then
        Begin
          sym := becomes;
          getch
        End
      Else 
        sym := nul;
    End

  Else {处理其它算符或标点符号}
    Begin
      sym := ssym[ch];
      getch
    End
End {getsym};


Procedure  gen(x : fct; y, z : integer);
Begin
  If cx > cxmax Then {如果当前指令序号>代码的最大长度}
    Begin
      write('Program TOO LONG');
      writeln(fout);
      close(fin);
      // goto 99
      exit();
    End;
  With code[cx] Do {在代码数组cx位置生成一条新代码}
    Begin
      f := x; {功能码}
      l := y; {层号}
      a := z {地址}
    End;
  cx := cx + 1 {指令序号加1}
End {gen};


Procedure  test(s1, s2 : symset; n : integer);
Begin
  If not (sym In s1) Then
  {如果当前记号不属于集合S1,则报告错误n}
    Begin
      error(n);
      s1 := s1 + s2;
      While not (sym In s1) Do
        getsym
        {跳过一些记号, 直到当前记号属于S1∪S2}
    End
End {test};


Procedure  block(lev, tx : integer; fsys : symset);
  Var dx : integer; {本过程数据空间分配下标}
      tx0 : integer; {本过程标识表起始下标}
      cx0 : integer; {本过程代码起始下标}

  Procedure  enter(k : Object2);
  Begin {把object填入符号表中}
    tx := tx +1; {符号表指针加1}
    With table[tx] Do{在符号表中增加新的一个条目}
    Begin
      name := id; {当前标识符的名字}
      kind := k; {当前标识符的种类}
      Case k Of 
        constant :
          Begin {当前标识符是常数名}
            If num > amax Then {当前常数值大于上界,则出错}
              Begin error(30); num := 0 End;
            val := num
          End;
        variable :
          Begin {当前标识符是变量名}
            level := lev; {定义该变量的过程的嵌套层数}
            adr := dx; {变量地址为当前过程数据空间栈顶}
            dx := dx +1; {栈顶指针加1}
          End;
        Procedure2 : level := lev {本过程的嵌套层数}
      End
    End
  End {enter};

  Function  position(id : alfa) : integer; {返回id在符号表的入口}
    Var  i : integer;
  Begin {在标识符表中查标识符id}
    table[0].name := id; {在符号表栈的最下方预填标识符id}
    i := tx; {符号表栈顶指针}
    While table[i].name <> id Do i := i-1;
    {从符号表栈顶往下查标识符id}
    position := i {若查到,i为id的入口,否则i=0 }
  End {position};

  Procedure constdeclaration;
  Begin
    If sym = ident Then {当前记号是常数名}
      Begin
        getsym;
        If sym In [eql, becomes] Then {当前记号是等号或赋值号}
          Begin
            If sym = becomes Then error(1);
              {如果当前记号是赋值号,则出错}
            getsym;
            If sym = number Then {等号后面是常数}
              Begin
                enter(constant); {将常数名加入符号表}
                getsym
              End
            Else error(2) {等号后面不是常数出错}
          End
        Else error(3) {标识符后不是等号或赋值号出错}
      End
    Else error(4) {常数说明中没有常数名标识符}
  End {constdeclaration};

  Procedure  vardeclaration;
  Begin
    If sym = ident Then {如果当前记号是标识符}
      Begin
        enter(variable); {将该变量名加入符号表的下一条目}
        getsym
      End
    Else error(4) {如果变量说明未出现标识符,则出错}
  End {vardeclaration};

  Procedure  listcode;
    Var  i : integer;
  Begin  {列出本程序体生成的代码}
    For i := cx0 To cx-1 Do
    {cx0: 本过程第一个代码的序号, cx-1: 本过程最后一个代码的序号}
      With code[i] Do {打印第i条代码}
        writeln(fout, i:3, mnemonic[f] : 5, l : 3, a : 5)
    {i: 代码序号; 
    mnemonic[f]: 功能码的字符串;
    l: 相对层号(层差);
    a: 相对地址或运算号码}
  End {listcode};

  Procedure  statement(fsys : symset);
    Var  i, cx1, cx2 : integer;
    Procedure  expression(fsys : symset);
      Var  addop : symbol;
      Procedure  term(fsys : symset);
        Var  mulop : symbol;
        Procedure  factor(fsys : symset);
          Var i : integer;
          Begin
            test(facbegsys, fsys, 24);
            {测试当前的记号是否因子的开始符号, 
            否则出错, 跳过一些记号}
            While sym In facbegsys Do
            {如果当前的记号是否因子的开始符号}
              Begin
                If sym = ident Then {当前记号是标识符}
                  Begin
                    i := position(id); {查符号表,返回id的入口}
                    If i = 0 Then error(11)
                    Else
                    {若在符号表中查不到id, 则出错, 否则,做以下工作}
                    With table[i] Do
                      Case kind Of 
                        constant : gen(lit, 0, val);
                        {若id是常数, 生成指令,将常数val取到栈顶}
                        variable : gen(lod, lev-level, adr);
                        {若id是变量, 生成指令,将该变量取到栈顶;
                          lev: 当前语句所在过程的层号;
                          level: 定义该变量的过程层号;
                          adr: 变量在其过程的数据空间的相对地址}
                        Procedure2 : error(21)
                        {若id是过程名, 则出错}
                      End;
                    getsym {取下一记号}
                  End

                Else If sym = number Then {当前记号是数字}
                  Begin
                    If num > amax Then {若数值越界,则出错}
                    Begin
                      error(30);
                      num := 0
                    End;
                    gen(lit, 0, num);
                    {生成一条指令, 将常数num取到栈顶}
                    getsym {取下一记号}
                  End

                Else If sym = lparen Then {如果当前记号是左括号}
                  Begin
                    getsym; {取下一记号}
                    expression([rparen]+fsys); {处理表达式}
                    If sym = rparen Then getsym
                    {如果当前记号是右括号, 则取下一记号,否则出错}
                    Else error(22)
                  End;

              test(fsys, [lparen], 23)
              {测试当前记号是否同步, 否则出错, 跳过一些记号}
              End {while}
          End {factor};

        Begin {term}
          factor(fsys+[times, slash]); {处理项中第一个因子}
          While sym In [times, slash] Do
          {当前记号是“乘”或“除”号}
            Begin
              mulop := sym; {运算符存入mulop}
              getsym; {取下一记号}
              factor(fsys+[times, slash]); {处理一个因子}
              If mulop = times Then gen(opr, 0, 4)
              {若mulop是“乘”号,生成一条乘法指令}
              Else gen(opr, 0, 5)
              {否则, mulop是除号, 生成一条除法指令}
            End
        End {term};

      Begin {expression}
        If sym In [plus, minus] Then {若第一个记号是加号或减号}
          Begin
            addop := sym;  {“+”或“-”存入addop}
            getsym;
            term(fsys+[plus, minus]); {处理一个项}
            If addop = minus Then gen(opr, 0, 1)
            {若第一个项前是负号, 生成一条“负运算”指令}
          End
        Else term(fsys+[plus, minus]);
        {第一个记号不是加号或减号, 则处理一个项}
        While sym In [plus, minus] Do {若当前记号是加号或减号}
          Begin
            addop := sym; {当前算符存入addop}
            getsym; {取下一记号}
            term(fsys+[plus, minus]); {处理一个项}
            If addop = plus Then gen(opr, 0, 2)
            {若addop是加号, 生成一条加法指令}
            Else gen(opr, 0, 3)
            {否则, addop是减号, 生成一条减法指令}
          End
      End {expression};

    Procedure  condition(fsys : symset);
      Var  relop : symbol;
      Begin
        If sym = oddsym Then {如果当前记号是“odd”}
          Begin
            getsym;  {取下一记号}
            expression(fsys); {处理算术表达式}
            gen(opr, 0, 6)
            {生成指令,判定表达式的值是否为奇数,
            是,则取“真”;不是, 则取“假”}
          End
        Else {如果当前记号不是“odd”}
          Begin
            expression([eql, neq, lss, gtr, leq, geq] + fsys);
            {处理算术表达式}
            If not (sym In [eql, neq, lss, leq, gtr, geq]) Then
            {如果当前记号不是关系符, 则出错; 否则,做以下工作}
              error(20)
            Else
              Begin
                relop := sym; {关系符存入relop}
                getsym; {取下一记号}
                expression(fsys); {处理关系符右边的算术表达式}
                Case relop Of 
                  eql : gen(opr, 0, 8);
                  {生成指令, 判定两个表达式的值是否相等}
                  neq : gen(opr, 0, 9);
                  {生成指令, 判定两个表达式的值是否不等}
                  lss : gen(opr, 0, 10);
                  {生成指令,判定前一表达式是否小于后一表达式}
                  geq : gen(opr, 0, 11);
                  {生成指令,判定前一表达式是否大于等于后一表达式}
                  gtr : gen(opr, 0, 12);
                  {生成指令,判定前一表达式是否大于后一表达式}
                  leq : gen(opr, 0, 13);
                  {生成指令,判定前一表达式是否小于等于后一表达式}
                End
              End
            End
        End {condition};

    Begin {statement}
      If sym = ident Then {处理赋值语句}
        Begin
          i := position(id);
          {在符号表中查id, 返回id在符号表中的入口}
          If i = 0 Then error(11)
          {若在符号表中查不到id, 则出错, 否则做以下工作}
          Else If table[i].kind <> variable Then
            {若标识符id不是变量, 则出错}
            Begin {对非变量赋值}
              error(12);
              i := 0;
            End;
          getsym; {取下一记号}
          If sym = becomes Then getsym
          Else error(13);
          {若当前是赋值号, 取下一记号, 否则出错}
          expression(fsys); {处理表达式}
          If i <> 0 Then {若赋值号左边的变量id有定义}
            With table[i] Do gen(sto, lev-level, adr)
            {生成一条存数指令, 将栈顶(表达式)的值存入变量id中;
              lev: 当前语句所在过程的层号;
              level: 定义变量id的过程的层号;
              adr: 变量id在其过程的数据空间的相对地址}
        End
          
      Else If sym = callsym Then {处理过程调用语句}
        Begin
          getsym; {取下一记号}
          If sym <> ident Then error(14)
          Else
          {如果下一记号不是标识符(过程名),则出错,
            否则做以下工作}
            Begin
              i := position(id); {查符号表,返回id在表中的位置}
              If i = 0 Then error(11)
              Else
                {如果在符号表中查不到, 则出错; 否则,做以下工作}
                With table[i] Do
                  If kind = Procedure2 Then
                    {如果在符号表中id是过程名}
                    gen(cal, lev-level, adr)
                    {生成一条过程调用指令;
                      lev: 当前语句所在过程的层号
                      level: 定义过程名id的层号;
                      adr: 过程id的代码中第一条指令的地址}
                  Else error(15); {若id不是过程名,则出错}
              getsym {取下一记号}
            End
        End

      Else If sym = ifsym Then {处理条件语句}
        Begin
          getsym; {取下一记号}
          condition([thensym, dosym]+fsys); {处理条件表达式}
          If sym = thensym Then getsym
          Else error(16);
          {如果当前记号是“then”,则取下一记号; 否则出错}
          cx1 := cx; {cx1记录下一代码的地址}
          gen(jpc, 0, 0);
          {生成指令,表达式为“假”转到某地址(待填),
          否则顺序执行}
          statement(fsys); {处理一个语句}
          code[cx1].a := cx
          {将下一个指令的地址回填到上面的jpc指令地址栏}
        End
      
      Else If sym = beginsym Then {处理语句序列}
        Begin
          getsym;
          statement([semicolon, endsym]+fsys);
          {取下一记号, 处理第一个语句}
          While sym In [semicolon]+statbegsys Do
          {如果当前记号是分号或语句的开始符号,则做以下工作}
            Begin
              If sym = semicolon Then getsym
              Else error(10);
              {如果当前记号是分号,则取下一记号, 否则出错}
              statement([semicolon, endsym]+fsys) {处理下一个语句}
            End;
          If sym = endsym Then getsym
          Else error(17)
          {如果当前记号是“end”,则取下一记号,否则出错}
        End

      Else If sym = whilesym Then {处理循环语句}
        Begin
          cx1 := cx; {cx1记录下一指令地址,即条件表达式的
                      第一条代码的地址}
          getsym; {取下一记号}
          condition([dosym]+fsys); {处理条件表达式}
          cx2 := cx; {记录下一指令的地址}
          gen(jpc, 0, 0); {生成一条指令,表达式为“假”转到某地
                            址(待回填), 否则顺序执行}
          If sym = dosym Then getsym
          Else error(18);
          {如果当前记号是“do”,则取下一记号, 否则出错}
          statement(fsys); {处理“do”后面的语句}
          gen(jmp, 0, cx1); {生成无条件转移指令, 转移到“while”后的
                              条件表达式的代码的第一条指令处}
          code[cx2].a := cx
          {把下一指令地址回填到前面生成的jpc指令的地址栏}
        End

      {###################### read语句 ######################}
      Else If sym = readsym Then {处理read语句}
        Begin
          getsym; {取下一记号}
          If sym = lparen Then {如果read后跟的是左括号}
            Repeat
              getsym;
              If sym = ident Then
                Begin
                  i := position(id);
                  {在符号表中查id, 返回id在符号表中的入口}
                  If i = 0 Then error(11)
                  {若在符号表中查不到id, 则出错, 否则做以下工作}
                  Else If table[i].kind <> variable Then
                    {若标识符id不是变量, 则出错}
                    Begin {对非变量赋值}
                      error(12);
                      i := 0;
                    End
                  Else With table[i] Do gen(red, lev-level, adr)
                    {生成一条RED指令;
                      lev: 当前语句所在过程的层号;
                      level: 定义变量id的过程的层号;
                      adr: 变量id在其过程的数据空间的相对地址}
                End
              Else error(4); {如果变量说明未出现标识符,则出错}
              getsym;
            Until sym <> comma {直到当前记号不是逗号}
          Else error(40); {如果read后跟的不是左括号,出错}
          If sym <> rparen Then error(22); {漏右括号,出错}
          getsym
        End {处理read语句}   

      {###################### write语句 ######################}
      Else if sym = writesym Then {处理write语句}
        Begin
          getsym; {取下一记号}
          If sym = lparen Then {如果write后跟的是左括号}
            Begin
              Repeat
                getsym;
                expression([rparen,comma]+fsys);
                gen(wrt, 0, 0);
              Until sym <> comma; {直到当前记号不是逗号}
              If sym <> rparen Then error(22); {漏右括号,出错}
              getsym
            End
          Else error(40) {如果write后跟的不是左括号,出错}
        End; {处理write语句}
            
      test(fsys, [ ], 19)
      {测试下一记号是否正常, 否则出错, 跳过一些记号}
    End {statement};

  Begin {block}
    dx := 3; {本过程数据空间栈顶指针}
    tx0 := tx; {标识符表的长度(当前指针)}
    table[tx].adr := cx; {本过程名的地址, 即下一条指令的序号}
    gen(jmp, 0, 0); {生成一条转移指令}
    If lev > levmax Then error(32);
    {如果当前过程层号>最大层数, 则出错}
    Repeat
      If sym = constsym Then {处理常数说明语句}
        Begin
          getsym;
          Repeat
            constdeclaration; {处理一个常数说明}
            While sym = comma Do {如果当前记号是逗号}
              Begin
                getsym;
                constdeclaration
              End; {处理下一个常数说明}
            If sym = semicolon Then getsym
            Else error(5)
            {如果当前记号是分号,则常数说明已处理完, 否则出错}
          Until sym <> ident
          {跳过一些记号, 直到当前记号不是标识符(出错时才用到)}
        End;

      If sym = varsym Then {当前记号是变量说明语句开始符号}
        Begin
          getsym;
          Repeat
            vardeclaration; {处理一个变量说明}
            While sym = comma Do {如果当前记号是逗号}
              Begin
                getsym;
                vardeclaration
              End;
            {处理下一个变量说明}
            If sym = semicolon Then getsym
            Else error(5)
            {如果当前记号是分号,则变量说明已处理完, 否则出错}
          Until sym <> ident;
          {跳过一些记号, 直到当前记号不是标识符(出错时才用到)}
        End;
      While sym = procsym Do {处理过程说明}
        Begin
          getsym;
          If sym = ident Then {如果当前记号是过程名}
            Begin
              enter(Procedure2);
              getsym
            End
          {把过程名填入符号表}
          Else error(4); {否则, 缺少过程名出错}
          If sym = semicolon Then getsym
          Else error(5);
          {当前记号是分号, 则取下一记号,否则,过程名后漏掉分号出错}
          block(lev+1, tx, [semicolon]+fsys); {处理过程体}
          {lev+1: 过程嵌套层数加1; tx: 符号表当前栈顶指针,
            也是新过程符号表起始位置; [semicolon]+fsys: 过程体开始和末尾符号集}
          If sym = semicolon Then {如果当前记号是分号}
            Begin
              getsym; {取下一记号}
              test(statbegsys+[ident, procsym], fsys, 6)
              {测试当前记号是否语句开始符号或过程说明开始符号,
                否则报告错误6, 并跳过一些记号}
            End
          Else error(5) {如果当前记号不是分号,则出错}
        End; {while}
      test(statbegsys+[ident], declbegsys, 7)
      {检测当前记号是否语句开始符号, 否则出错, 并跳过一些记号}
    Until not (sym In declbegsys);
    {回到说明语句的处理(出错时才用),直到当前记号不是说明语句的开始符号}
    code[table[tx0].adr].a := cx;
    {table[tx0].adr是本过程名的第1条
      代码(jmp, 0, 0)的地址,本语句即是将下一代码(本过程语句的第
      1条代码)的地址回填到该jmp指令中,得(jmp, 0, cx)}
    With table[tx0] Do {本过程名的第1条代码的地址改为下一指令地址cx}
      Begin
        adr := cx; {代码开始地址}
      End;
    cx0 := cx; {cx0记录起始代码地址}
    gen(int, 0, dx); {生成一条指令, 在栈顶为本过程留出数据空间}
    statement([semicolon, endsym]+fsys); {处理一个语句}
    gen(opr, 0, 0); {生成返回指令}
    test(fsys, [ ], 8); {测试过程体语句后的符号是否正常,否则出错}
    listcode; {打印本过程的中间代码序列}
  End  {block};



Procedure  interpret;
  Const stacksize = 500; {运行时数据空间(栈)的上界}
  Var p, b, t : integer; {程序地址寄存器, 基地址寄存器,栈顶地址寄存器}
      i : instruction; {指令寄存器}
      s : array [1..stacksize] Of integer; {数据存储栈}

  Function  base(l : integer) : integer;
    Var  b1 : integer;
    Begin
      b1 := b; {顺静态链求层差为l的外层的基地址}
      While l > 0 Do
        Begin
          b1 := s[b1];
          l := l-1
        End;
      base := b1
    End {base};

  Begin
    writeln('START PL/0');
    writeln(fout, 'START PL/0');
    t := 0; {栈顶地址寄存器}
    b := 1; {基地址寄存器}
    p := 0; {程序地址寄存器}
    s[1] := 0;
    s[2] := 0;
    s[3] := 0;
    {最外层主程序数据空间栈最下面预留三个单元}
    {每个过程运行时的数据空间的前三个单元是:SL, DL, RA;
    SL: 指向本过程静态直接外层过程的SL单元;
    DL: 指向调用本过程的过程的最新数据空间的第一个单元;
    RA: 返回地址 }
    Repeat
      i := code[p]; {i取程序地址寄存器p指示的当前指令}
      p := p+1; {程序地址寄存器p加1,指向下一条指令}
      With i Do
        Case f Of 
          lit :
            Begin {当前指令是取常数指令(lit, 0, a)}
              t := t+1;
              s[t] := a
            End;
            {栈顶指针加1, 把常数a取到栈顶}
          opr : Case a Of {当前指令是运算指令(opr, 0, a)}
            0 :
              Begin {a=0时,是返回调用过程指令}
                t := b-1; {恢复调用过程栈顶}
                p := s[t+3]; {程序地址寄存器p取返回地址}
                b := s[t+2]; {基地址寄存器b指向调用过程的基地址}
              End;
            1 : s[t] := -s[t]; {一元负运算, 栈顶元素的值反号}
            2 :
              Begin {加法}
                t := t-1;
                s[t] := s[t] + s[t+1]
              End;
            3 :
              Begin {减法}
                t := t-1;
                s[t] := s[t]-s[t+1]
              End;
            4 :
              Begin {乘法}
                t := t-1;
                s[t] := s[t] * s[t+1]
              End;
            5 :
              Begin {整数除法}
                t := t-1;
                s[t] := s[t] Div s[t+1]
              End;
            6 : s[t] := ord(odd(s[t])); 
              {算s[t]是否奇数, 是则s[t]=1, 否则s[t]=0}
            8 :
              Begin
                t := t-1;
                s[t] := ord(s[t] = s[t+1])
              End;
              {判两个表达式的值是否相等,是则s[t]=1,否则s[t]=0}
            9:
              Begin
                t := t-1;
                s[t] := ord(s[t] <> s[t+1])
              End;
              {判两个表达式的值是否不等,是则s[t]=1,否则s[t]=0}
            10 :
              Begin
                t := t-1;
                s[t] := ord(s[t] < s[t+1])
              End;
              {判前一表达式是否小于后一表达式,是则s[t]=1,否则s[t]=0}
            11:
              Begin
                t := t-1;
                s[t] := ord(s[t] >= s[t+1])
              End;
              {判前一表达式是否大于或等于后一表达式,是则s[t]=1,否则s[t]=0}
            12 :
              Begin
                t := t-1;
                s[t] := ord(s[t] > s[t+1])
              End;
              {判前一表达式是否大于后一表达式,是则s[t]=1,否则s[t]=0}
            13 :
              Begin
                t := t-1;
                s[t] := ord(s[t] <= s[t+1])
              End;
              {判前一表达式是否小于或等于后一表达式,是则s[t]=1,否则s[t]=0}
            End;
          lod :
            Begin {当前指令是取变量指令(lod, l, a)}
              t := t + 1;
              s[t] := s[base(l) + a]
              {栈顶指针加1, 根据静态链SL,将层差为l,
                相对地址为a的变量值取到栈顶}
            End;
          sto :
            Begin {当前指令是保存变量值(sto, l, a)指令}
              s[base(l) + a] := s[t];
              writeln(s[t]);
              writeln(fout, s[t]);
              {根据静态链SL,将栈顶的值存入层差为l,
                相对地址为a的变量中}
              t := t-1 {栈顶指针减1}
            End;
          cal :
            Begin {当前指令是(cal, l, a)}
              {为被调用过程数据空间建立连接数据}
              s[t+1] := base( l );
              {根据层差l找到本过程的静态直接外层过程的数据空间的SL单元,
                将其地址存入本过程新的数据空间的SL单元}
              s[t+2] := b; {调用过程的数据空间的起始地址存入本过程DL单元}
              s[t+3] := p; {调用过程cal指令的下一条的地址存入本过程RA单元}
              b := t+1; {b指向被调用过程新的数据空间起始地址}
              p := a {指令地址寄存储器指向被调用过程的地址a}
            End;
          int : t := t + a;
            {若当前指令是(int, 0, a), 则数据空间栈顶留出a大小的空间}
          jmp : p := a;
            {若当前指令是(jmp, 0, a), 则程序转到地址a执行}
          jpc :
            Begin {当前指令是(jpc, 0, a)}
              If s[t] = 0 Then p := a;
              {如果当前运算结果为“假”(0),程序转到地址a执行,否则顺序执行}
              t := t-1 {数据栈顶指针减1}
            End;

          red :
            Begin {当前指令是red}
              writeln('Input an integer: ');
              readln(s[base(l)+a]); {读一行数据,读入到层差为l,相对地址为a的变量值}
              writeln('Input: ', s[base(l)+a]);
              writeln(fout, 'Input: ', s[base(l)+a]);
            End;
          wrt :
            Begin {当前指令是wrt}
              writeln('Output: ', s[t]);
              writeln(fout, 'Output: ', s[t]);
              t := t+1 {数据栈顶指针加1}
            End
        End {with, case}
    Until p = 0;
    {程序一直执行到p取最外层主程序的返回地址0时为止}
    write('End PL/0');
    write(fout, 'End PL/0');
  End {interpret};


Begin  {主程序}
  writeln('Input PL0 src file name: ');
  readln(srcfile);
  assign(fin, srcfile); {将文件名字符串str赋给文件变量fin,
                        程序对文件变量fin的操作代替对文件str的操作}
  reset(fin); {打开文件}

  writeln('Input dst file name: ');
  readln(dstfile);
  assign(fout, dstfile);
  rewrite(fout); {新建文件(如果文件已经存在则冲掉)}

  For ch := 'a' To ';' Do ssym[ch] := nul;
  {ASCII码的顺序}
  {注意前面(二分查找)找关键字是按ASCII码顺序来找的,
   所以下面的关键字必须是ASCII码的顺序}
  word[1] := 'begin     ';
  word[2] := 'call      ';
  word[3] := 'const     ';
  word[4] := 'do        ';
  word[5] := 'end       ';
  word[6] := 'if        ';
  word[7] := 'odd       ';
  word[8] := 'procedure ';
  word[9] := 'read      ';
  word[10]:= 'then      ';
  word[11]:= 'var       ';
  word[12]:= 'while     ';
  word[13]:= 'write     ';

  wsym[1] := beginsym;
  wsym[2] := callsym;
  wsym[3] := constsym;
  wsym[4] := dosym;
  wsym[5] := endsym;
  wsym[6] := ifsym;
  wsym[7] := oddsym;
  wsym[8] := procsym;
  wsym[9] := readsym;
  wsym[10]:= thensym;
  wsym[11]:= varsym;
  wsym[12]:= whilesym;
  wsym[13]:= writesym;

  ssym['+'] := plus;
  ssym['-'] := minus;
  ssym['*'] := times;
  ssym['/'] := slash;
  ssym['('] := lparen;     
  ssym[')'] := rparen;
  ssym['='] := eql;
  ssym[','] := comma;
  ssym['.'] := period;
  ssym['!'] := neq; {不等号用!表示}
  ssym['<'] := lss;
  ssym['>'] := gtr;
  ssym['@'] := leq; {小于等于号用@表示}
  ssym['#'] := geq; {大于等于号用#表示}
  ssym[';'] := semicolon;
  {算符和标点符号的记号}

  mnemonic[lit] := '  LIT  ';
  mnemonic[opr] := '  OPR  ';
  mnemonic[lod] := '  LOD  ';
  mnemonic[sto] := '  STO  ';
  mnemonic[cal] := '  CAL  ';
  mnemonic[int] := '  INT  ';
  mnemonic[jmp] := '  JMP  ';
  mnemonic[jpc] := '  JPC  ';
  mnemonic[red] := '  RED  ';
  mnemonic[wrt] := '  WRT  ';
  {中间代码指令的字符串}

  declbegsys := [constsym, varsym, procsym];
  {说明语句的开始符号}
  statbegsys := [beginsym, callsym, ifsym, whilesym];
  {语句的开始符号}
  facbegsys := [ident, number, lparen];
  {因子的开始符号}

  // page(output);
  err := 0; {发现错误的个数}
  cc := 0; {当前行中输入字符的指针}
  cx := 0; {代码数组的当前指针}
  ll := 0; {输入当前行的长度}
  ch := ' '; {当前输入的字符}
  kk := al; {标识符的长度}
  getsym; {取下一个记号}
  block(0, 0, [period]+declbegsys+statbegsys); {处理程序体}
  If sym <> period Then error(9);
  {如果当前记号不是句号, 则出错}
  If err = 0 Then interpret
  {如果编译无错误, 则解释执行中间代码}
  Else 
    Begin
      write('ERRORS In PL/0 Program');
      write(fout, 'ERRORS In PL/0 Program');
    End;
  writeln;
  close(fin);
  readln(srcfile);
  close(fout);
End.