pl0.pas

一个词法分析器还有实验的说明

      end;
    end
  end
end(*condition*);


begin(*statement*)
  if sym=ident then
  begin
    i:=position(id);
    if i=0 then error(11)
    else
      if table[i].kind<>variable then
      begin
	error(12);
	i:=0;
      end;
      getsym;

      if sym=becomes then getsym
      else error(13);
      expression(fsys);
      if i<>0 then
        with table[i] do gen(sto,lev-level,adr);
    end
    else

    if sym=readsym then
    begin
      getsym;
      if sym<>lparen then error(34)
      else
      repeat
	getsym;
	if sym=ident then i:=position(id)
        else i:=0;
        if i=0 then error(35)
        else
	with table[i] do
	begin
	  gen(opr,0,16);
	  gen(sto,lev-level,adr);
        end;
	getsym;
      until sym<>comma;
      if sym<>rparen then
      begin
        error(33);
	while not(sym in fsys)do getsym;
      end
      else getsym;
    end
    else

    if sym=writesym then
    begin
      getsym;
      if sym=lparen then
      begin
      repeat
	getsym;
        expression([rparen,comma]+fsys);
	gen(opr,0,14)
      until sym<>comma;
      if sym<>rparen then error(33)
      else getsym;
    end;
    gen(opr,0,15);
    end
    else

      if sym=callsym then
      begin
        getsym;
        if sym<>ident then error(14)
        else
        begin
          i:=position(id);
          if i=0 then error(11)
          else
	    with table[i] do
	      if kind=procedur then gen(cal,lev-level,adr)
              else error(15);
	    getsym;
          end;
        end
        else

      if sym=ifsym then
      begin
	getsym;
	condition([thensym,dosym]+fsys);
        if sym=thensym then getsym
	else error(16);
	cx1:=cx;
	gen(jpc,0,0);
	statement(fsys);
	code[cx1].a:=cx;
      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
      else

      if sym=whilesym then
      begin
	cx1:=cx;
	getsym;
	condition([dosym]+fsys);
	cx2:=cx;
	gen(jpe,0,0);
        if sym=dosym then getsym
        else error(18);
        statement(fsys);
        gen(jmp,0,cx1);
        code[cx2].a:=cx
      end;
    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
		vardeclararion;
		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(procedur);
getsym
end
else error(4)
if sym=semicolon
then getsym
else error(5);
block(lev+1,tx,[semicolon]+fsys);
if sym= semicolon
then
begin
getsym;
test(statbegsys+[ident],procsym),fys,6);
end
else error(5)
end;
test(statbegsys+[ident],declbegsys,7)
until not(sym in declbegsys);
code[table[tx0].adr].a:=cx;
with table[tx0] do
begin
adr:=cx;
size:=dx;
end;
cx0:=cx;
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;(*program base topstack registers*)
I:instruction;
S:arry[1..stacksize]of integer;(*datastore*)

Function base(l:integer):integer;
Var b1:integer;
Begin
B1:=b;(*find base 1 level down*)
While l>0 do
Begin
B1:=s[b1];
L:=l-1
End;
Base:=b1
End(*base*);


    begin
	writeln('start pl0');
	t:=0;b:=1;p:=0;
	s[1]:=0;s[2]:=0;s[3]:=0;
	repeat
	 i:=code[p];
	 p:=p+1;
	 with i do
	  case f of
	   lit:begin
		t:=t+1;
		s[t]:=a;
	       end;
	   opr:case a of   (* opreator*)
	    0:begin (*return*)
		t:=b-1;
		p:=s[t+3];
		b:=s[t+2];
	      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]));
	    8:begin
		t:=t-1;
		s[t]:=ord(s[t]=s[t+1])
		end;
	    9:begin
		t:=t-1;
		s[t]:=ord(s[t]<>s[t+1])
	      end;
	   10:begin
		t:=t-1;
		s[t]:=ord(s[t]<s[t+1])
	      end;
	   11:begin
		t:=t-1;
		s[t]:=ord(s[t]>=s[t+1])
	      end;
	    12:begin
		t:=t-1;
		s[t]:=ord(s[t]>s[t+1])
	      end;
	    13:begin
		t:=t-1;
		s[t]:=ord(s[t]<=s[t+1])
	      end;	
	    14:begin
		write(s[t]);
		weite(fa2,s[t]);
		t:=t-1;
	      end;
	    15:begin
		writeln;
		writeln(fa2);
	       end;
	    16:begin
		t:=t+1;
		write('?');
		write(fa2,'?');
		readln(s[t]);
	      end;
	   end;
	lod:begin
	     t:=t+1;
	     s[t]:=s[base(1)+a]
	   end;
	sto:begin
	     s[base(1)+a=s[t];         (*writeln(s[t])*)
	     t:=t-1;
	    end;
	cal:begin(*generat new block mark*)
	      s[t+1]:=base(1);
	      s[t+2]:=b;
	      s[t+3]:=p;
	      b:=t+1;
	      p:=a;
	    end;
	int:t:=t+a;
	jmp:p:=a;
	jpc:begin
		 if s[t]=0
		    then p:=a;
		 t:=t-1;
	    end;
	end(* with,case *)
      until p=0;
      closef(fa2)
    end(* interpret *);




    begin(*main*)
	for ch:=' 'to'!'do ssym[ch]:=nul;
		(* changed because of different character set note the typos below in the
		   original where the alfas were not given correct space *)
	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]:=insym;
	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[';']:=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   ';
	

	declbegsys:=[constsym,varsym,procsym];
	statbegsys:=[beginsym,callsym,ifsym,whilesym];
	facbegsys:=[ident,number,lparen];

	(*page(output)*)
	rewrite(fal);
	write('input file?  ');
	write(fal,'input file?');
	readln(fname);
	writeln(fal,fname);
	openf(fin,fname,'r');
	write('list object code ?');
	readln(fname);
	write(fal,'list object code ?');
	listswitch:=(fname[1]='y');
	err:=0;
	cc:=0;;cx:=0;ll:=0;
	ch:=' ';kk:=al;
	getsym;
	rewrite(fa);
	rewrite(fa2);
	block(0,0,[period]+declbegsys+statbegsys);
	closef(fa);
	closef(fal);
	if sym<>period
	  then interpret
	  else write('errors in pl/0 program');
	99:
	  closef(fin);
	  writeln
	end.