pl.pas

pl0编译器

  function base(l:integer):integer;
  var 
    b1: integer;
  begin
    b1:=b; (* find base 1 level down *) (* 首先从当前层开始 *)
    while l>0 do (* 如果l大于0，循环通过静态链往前找需要的数据区基址 *)
    begin
      b1:=s[b1]; (* 用当前层数据区基址中的内容（正好是静态链SL数据，为上一层的基址）的作为新的当前层，即向上找了一层 *)
      l:=l-1 (* 向上了一层，l减一 *)
    end;
    base:=b1 (* 把找到的要求的数据区基址返回 *)
  end(* base *);
begin
  writeln('start pl0'); (* PL/0程序开始运行 *)
  t:=0; (* 程序开始运行时栈顶寄存器置0 *)
  b:=1; (* 数据段基址为1 *)
  p:=0; (* 从0号代码开始执行程序 *)
  s[1]:=0; 
  s[2]:=0;
  s[3]:=0; (* 数据内存中为SL,DL,RA三个单元均为0，标识为主程序 *)
  repeat (* 开始依次运行程序目标代码 *)
    i:= code[p]; (* 获取一行目标代码 *)
    p:=p+1; (* 指令指针加一，指向下一条代码 *)
    with i do 
      case f of (* 如果i的f，即指令助记符是下面的某种情况，执行不同的功能 *)
        lit: (* 如果是lit指令 *)
        begin
          t:=t+1; (* 栈顶指针上移，在栈中分配了一个单元 *)
          s[t]:=a ;(* 该单元的内容存放i指令的a操作数，即实现了把常量值放到运行栈栈顶 *)
        end;
        opr: (* 如果是opr指令 *)
          case a of (* operator *) (* 根据a操作数不同，执行不同的操作 *)
            0: (* 0号操作为从子过程返回操作 *)
            begin (* return *)
              t:=b-1; (* 释放这段子过程占用的数据内存空间 *)
              p:=s[t+3]; (* 把指令指针取到RA的值，指向的是返回地址 *)
              b:=s[t+2]; (* 把数据段基址取到DL的值，指向调用前子过程的数据段基址 *)
            end;
            1: (* 1号操作为栈顶数据取反操作 *)
              s[t]:=-s[t]; (* 对栈顶数据进行取反 *)
            2: (* 2号操作为栈顶两个数据加法操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *) 
              s[t]:=s[t]+s[t+1] (* 把两单元数据相加存入栈顶 *)
            end;
            3: (* 3号操作为栈顶两个数据减法操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *) 
              s[t]:=s[t]-s[t+1] (* 把两单元数据相减存入栈顶 *)
            end;
            4: (* 4号操作为栈顶两个数据乘法操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *)
              s[t]:=s[t]*s[t+1] (* 把两单元数据相乘存入栈顶 *)
            end;
            5: (* 5号操作为栈顶两个数据除法操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *)
              s[t]:=s[t] div s[t+1] (* 把两单元数据相整除存入栈顶 *)
            end;
            6: (* 6号操作为判奇操作 *)
              s[t]:=ord(odd(s[t])); (* 数据栈顶的值是奇数则把栈顶值置1，否则置0 *)
            8: (* 8号操作为栈顶两个数据判等操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *)
              s[t]:=ord(s[t]= s[t+1]) (* 判等，相等栈顶置1，不等置0 *)
            end;
            9: (* 9号操作为栈顶两个数据判不等操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *)
              s[t]:=ord(s[t]<>s[t+1]) (* 判不等，不等栈顶置1，相等置0 *)
            end;
            10: (* 10号操作为栈顶两个数据判小于操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *)
              s[t]:=ord(s[t]<s[t+1]) (* 判小于，如果下面的值小于上面的值，栈顶置1，否则置0 *)
            end;
            11: (* 11号操作为栈顶两个数据判大于等于操作 *)
            begin
              t:=t - 1; (* 栈顶指针下移 *)
              s[t]:=ord(s[t] >= s[t + 1]) (* 判大于等于，如果下面的值大于等于上面的值，栈顶置1，否则置0 *)
            end;
            12: (* 12号操作为栈顶两个数据判大于操作 *)
            begin
              t:= t-1; (* 栈顶指针下移 *)
              s[t]:=ord(s[t]>s[t+1]) (* 判大于，如果下面的值大于上面的值，栈顶置1，否则置0 *)
            end;
            13: (* 13号操作为栈顶两个数据判小于等于操作 *)
            begin
              t:=t-1; (* 栈顶指针下移 *)
              s[t]:=ord(s[t]<=s[t+1]) (* 判小于等于，如果下面的值小于等于上面的值，栈顶置1，否则置0 *)
            end;
            14: (* 14号操作为输出栈顶值操作 *)
            begin
              write(s[t]); (* 输出栈顶值 *)
              write(fa2,s[t]); (* 同时打印到文件 *)
              t:=t-1 (* 栈顶下移 *)
            end;
            15: (* 15号操作为输出换行操作 *)
            begin
              writeln; (* 输出换行 *)
              writeln(fa2) (* 同时输出到文件 *)
            end;
            16: (* 16号操作是接受键盘值输入到栈顶 *)
            begin
              t:=t+1; (* 栈顶上移，分配空间 *)
              write('?'); (* 屏显问号 *)
              write(fa2,'?'); (* 同时输出到文件 *)
              readln(s[t]); (* 获得输入 *)
              writeln(fa2,s[t]); (* 把用户输入值打印到文件 *)
            end;
          end; (* opr指令分析运行结束 *)
        lod: (* 如果是lod指令:将变量放到栈顶 *)
        begin
          t:=t+1; (* 栈顶上移，开辟空间 *)
          s[t]:=s[base(l)+a] (* 通过数据区层差l和偏移地址a找到变量的数据，存入上面开辟的新空间（即栈顶） *)
        end;
        sto: (* 如果是sto指令 *)
        begin
          s[base(l)+a]:=s[t]; (* 把栈顶的值存入位置在数据区层差l偏移地址a的变量内存 *)
          t:=t-1 (* 栈项下移，释放空间 *)
        end;
        cal: (* 如果是cal指令 *)
        begin (* generat new block mark *)
          s[t+1]:=base(l); (* 在栈顶压入静态链SL *)
          s[t+2]:=b; (* 然后压入当前数据区基址，作为动态链DL *)
          s[t+3]:=p; (* 最后压入当前的断点，作为返回地址RA *)
          (* 以上的工作即为过程调用前的保护现场 *)
          b:=t+1; (* 把当前数据区基址指向SL所在位置 *)
          p:=a; (* 从a所指位置开始继续执行指令，即实现了程序执行的跳转 *)
        end;
        int: (* 如果是int指令 *)
          t:= t + a; (* 栈顶上移a个空间，即开辟a个新的内存单元 *)
        jmp: (* 如果是jmp指令 *)
          p:= a; (* 把jmp指令操作数a的值作为下一次要执行的指令地址，实现无条件跳转 *)
        jpc: (* 如果是jpc指令 *)
        begin
          if s[t]=0 then (* 判断栈顶值 *)
            p:=a; (* 如果是0就跳转，否则不跳转 *)
          t:=t-1 (* 释放栈顶空间 *)
        end;
      end(* with,case *)
  until p=0; (* 如果p等于0，意味着在主程序运行时遇到了从子程序返回指令，也就是整个程序运行的结束 *)
  close(fa2) (* 关闭用于记录屏幕输入输出的fa2文件 *)
  (* PCODE代码的解释执行过程结束 *)
end(* interpret *);
begin (* main *)
  for ch:=' ' to '!' do (* 这个循环把ssym数组全部填nul *)
    ssym[ch]:=nul;
  (* changed because of different character set
  note the typos below in the original where
  the alfas were not given the correct space *)
  (* 下面初始化保留字表，保留字长度不到10个字符的，多余位置用空格填充，便于词法分析时以二分法来查找保留字 *)
  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;
  (* 初始化符号表，把可能出现的符号赋上相应的类型，其余符号由于开始处的循环所赋的类型均为nul *)
  ssym['+']:=plus;
  ssym['-']:=minus;
  ssym['*']:=times;
  ssym['/']:=slash;
  ssym['(']:=lparen;
  ssym[')']:=rparen;
  ssym['=']:=eql;
  ssym[',']:=comma;
  ssym['.']:=period;
  ssym['#']:=neq;
  ssym[';']:=semicolon;
  (* 初始化类PCODE助记符表，这个表主要供输出类PCODE代码之用 *)
  mnemonic[lit]:=' lit ';
  mnemonic[opr]:=' opr ';
  mnemonic[lod]:=' lod ';
  mnemonic[sto]:=' sto ';
  mnemonic[cal]:=' cal ';
  mnemonic[int]:=' int ';
  mnemonic[jmp]:=' jmp ';
  mnemonic[jpc]:=' jpc ';
 (* 这样改的目的是使后面的输出结果比较美观 *)
  declbegsys:=[constsym, varsym, procsym];
  statbegsys:=[beginsym, callsym, ifsym, whilesym];
  facbegsys:=[ident, number, lparen];
  (* page(output) *)
  (* 由于Turbo Pascal 7.0的文本文件处理方法与源程序中使用的方法有很大不同，因此下面的有关文件处理的代码进行了不少更改。 *)
  assign(fa1, 'fa1.txt'); (* 把文本文件fa1与fa1.txt文件关联起来，用于输出生成的类PCODE代码 *)
  rewrite(fa1); (* 建立并打开fa1.txt文件 *)
  write('input file?  '); (* 提示输入PL/0源程序名 *)
  write(fa1, 'input file? '); (* 同样的提示输出到fa1.txt文件 *)
  readln(fname); (* 获得键盘输入的文件名 *)
  writeln(fa1, fname); (* 把键盘输入打印到fa1.txt文件 *)
  {openf(fin,fname,'r');}
  assign(fin, fname); (* 把PL/0的源程序文件与fin关联 *)
  reset(fin); (* 打开fin所关联的PL/0源程序文件 *) 
  write('list object code ?'); (* 提示是否要列出类PCODE代码 *)
  readln(fname); (* 获得用户输入 *)
  write(fa1, 'list object code ?'); (* 同样的提示写到fa1.txt文件中 *)
  listswitch:=(fname[1]='y'); (* 如果输入'y'开头的字符串，把listswitch标志置true，否则为false *)
  err:=0; (* 出错次数置0 *)
  cc:=0; (* 词法分析行缓冲区指针置0 *)
  cx:=0; (* 类PCODE代码表指针置0 *)
  ll:=0; (* 词法分析行缓冲区长度置0 *)
  ch:=' '; (* 词法分析当前字符为空格 *)
  kk:=al; (* 置kk的值为允许的标识符的最长长度，具体用意见getsym过程注释 *)
  assign(fa, 'fa.txt'); (* 把fa.txt与fa关联。fa用于输出源程序 *)
  rewrite(fa); (* 建立并打开fa.txt *)
  getsym; (* 首次调用词法分析子程序，获取源程序的第一个词（token） *)
  block(0, 0, [period] + declbegsys + statbegsys); (* 开始进行主程序（也就是第一个分程序）的语法分析 *)
  (* 主程序所在层为0层，符号表暂时为空，符号表指针指0号位置 *)
  close(fa); (* 关闭文件 *)
  close(fa1); (* 关闭文件 *)
  if sym <> period then (* 主程序分析结束，应遇到表明程序结束的句号 *)
    error(9); (* 如果不是句号，出现9号错误 *)
  (* 以上可知，一个合法的PL/0源程序应由分程序和句号构成。 *)
  if err=0 then (* 如果出错次数为0，可以开始解释执行编译产生的代码 *)
  begin
    assign(fa2, 'fa2.txt'); (* 把文本文件fa2与fa2.txt文件关联起来，用于输出类PCODE代码运行结果 *)
    rewrite(fa2); (* 建立并打开fa2文件 *)
    interpret (* 开始解释执行类PCODE代码 *)
  end
  else
    write('errors in pl/0 program'); (* 如果有错误，提示程序有错误 *)
  99: (* 这个标号原来是用于退出程序的，由于Turbo Pascal不支持跨过程的跳转，因此这里这个标号也没用了。 *)
  {closef(fin);}
  close(fin); (* 关闭源程序文件 *)
  writeln
end.