program pl0(input , output);

(*
	Daniel Lain
  	100768056
  	Lab 4
  	4/11/13
*)


 (*obtained from www.moorecad.com/standardpascal*)
 (*pl/0 compiler with code generation*)
  (*
    0    3302 Lab 1, Spring 2013 BPW - add simple I/O
    0    1. "in"  stream may be used anywhere an r-value may be used.
    0    2. "out" stream may be used anywhere an l-value may be used.
    0    3. Input is taken to be one integer per line.
    0       -999999 terminates the input stream and is only passed on once.
    0       Second -999999 will abort.  "?" is the prompt.
    0    4. Output is one integer per line.
    0       Each output line starts with "!".
    0    5. The output stream does not terminate.
    0    6. Code listing and trace for "sto" have been disabled.
    0    7. The range check for error(30) has been corrected.
    0    8. "in" and "out" are identifiers for the two streams.  Like the
    0       rest of PL/0, these may be masked by other declarations.
    0  *)
  const norw = 11;     (*no. of reserved words*)
      txmax = 100;      (*length of identifier table*)
      kmax = 8;         (*max. no. of digits in numbers, changed from nmax BPW*)
      al = 10;          (*length of identifiers*)
      feedbacklevel = 0; (* feedback level 1 list code
                                           2 list generated code and vars
   		 			   3 list level 1 + 2
					   any other value no trace*)
      (*amax = 2047;*)    (*maximum address-removed BPW*)
      nmax = 99999999;  (*maximum value allowed in source program BPW*)
      levmax = 7;       (*maximum depth of block nesting*)
      cxmax = 5000;     (*size of code array*)
  (*type symbol =*)
      nul = 1;
      ident = 2;
      number = 3;
      plus = 4;
      minus = 5;
      times = 6;
      slash = 7;
      oddsym = 8;
      eql = 9;
      neq = 10;
      lss = 11;
      leq = 12;
      gtr = 13;
      geq = 14;
      lparen = 15;
      rparen = 16;
      comma = 17;
      semicolon = 18;
      period = 19;
      becomes = 20;
      beginsym = 21;
      endsym = 22;
      ifsym = 23;
      thensym = 24;
      whilesym = 25;
      dosym = 26;
      callsym = 27;
      constsym = 28;
      varsym = 29;
      procsym = 30;

      constant = 1;
      varible = 2;
      proc = 3;
      instream = 4;
      outstream = 5;

      lit = 1;
      opr = 2;
      lod = 3;
      sto = 4;
      cal = 5;
      int = 6;
      jmp = 7;
      jpc = 8;
      rdi = 9;
      wro = 10;
      mov = 11;
      pop = 12;
      type alfa = array [1..al] of char;
      symset = array [1..30] of integer;
(*  BPW - make all integers long, avoids problems
     like unreachable code for errors *)

      instruction = record
                       f: integer;       (*function code*)
                       l: integer;     (*level*)
                       a: (*0..amax*)
                          integer        (*displacement address*)
                    end;
  (*   lit 0,a  :  load constant a
      opr 0,a  :  execute operation a
      lod l,a  :  load varible l,a
      sto l,a  :  store varible l,a
    0      cal l,a  :  call procedure a at level l
    0      int 0,a  :  increment t-register by a
    0      jmp 0,a  :  jump to a
    0      jpc 0,a  :  jump conditional to a
    0      rdi 0,0 : read from instream
    0      wro 0,0 : write to outstream *)
  var ch: char;         (*last character read*)
      i:integer;
      sym: integer;      (*last symbol read*)
      addindex: integer; (* index to start adding to an array*)
      addsym: symset;
      id: alfa;         (*last identifier read*)
      procName: alfa;
      num: integer;     (*last number read*)
      backCounter: integer;
      cc: integer;      (*character count*)
      ll: integer;      (*line length*)
      kk, err: integer;
      wordtest: integer;
      cx: integer;      (*code allocation index*)
      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 integer;
      ssym: array [0..255] of integer;
      mnemonic: array [1..12] of
                    array [1..3] of char;
      declbegsys, statbegsys, facbegsys: symset;
      table: array [0..txmax] of
             record name: alfa;
                    kind: integer;
                    val: integer;
                    level,vars, adr: integer
                (*instream & outstream have no fields*)
             end;
  procedure checkword(w1, w2: alfa);
     var i,j:integer;

     begin
         j:=0;
         for i:=1 to al do
         begin
            if ((w1[i]<w2[i])and (j=0)) then
               begin
  	          wordtest :=-1;
  	          j:=1
  	      end;
            if ((w1[i]>w2[i]) and (j=0)) then
                begin
  	          wordtest :=1;
  	          j:=1
  	      end;
        end;
        if j=0 then wordtest:=0;
  end;(* checkword*)


 procedure error(n: integer);
  begin writeln(' ****',' ': cc-1, '^',n: 2); err := err+1
  end (*error*);

  procedure getsym;
     var i,j,k: integer;

     procedure getch;
     begin if cc = ll then
        begin
	   if eof(input) then
                   begin writeln(' program incomplete'); (*goto 99 halt(1)*)
                   end;
           ll := 0; cc := 0; write(cx: 5,' ');
           while not eoln(input) do
              begin ll := ll+1; read(ch); write(ch); line[ll]:=ch
              end;
           writeln; readln; ll := ll + 1; line[ll] := ' ';
        end;
        cc := cc+1; ch := line[cc]
     end (*getch*);

  begin (*getsym*)
     while ch  = ' ' do getch;
     if not((ch < 'a') or (ch > 'z')) then
     begin (*identifier or reserved word*) k := 0;
        repeat if k < al then
           begin k := k+1; a[k] := ch
           end;
           getch;
        until not(not((ch<'a') or (ch>'z')) or not((ch<'0') or (ch>'9')));
        if k >= kk then kk := k else
           repeat a[kk] := ' '; kk := kk-1
           until kk = k;
        id := a; i := 1; j := norw;
        repeat k := (i+j) div 2;
           checkword(id,word[k]);
  	 if wordtest <=0 then j:=k -1;
  	 if wordtest >=0 then i:=k +1;
        until i > j;
        if i-1 > j then sym := wsym[k] else sym := ident
     end else
     if not((ch<'0') or (ch>'9')) then
     begin (*number*) k := 0; num := 0; sym := number;
       repeat num := 10*num + (ord(ch)-ord('0'));
           k := k+1; getch
        until ((ch<'0') or (ch>'9'));
        if (k > kmax) or (num>nmax)  then
        begin
          error(30);
          num:=0 (*BPW - so error is reported once*)
        end
     end else
     if ch = ':' then
     begin getch;
        if ch = '=' then
        begin sym := becomes; getch
        end else sym := nul;
     end else
     begin sym := ssym[ord(ch)]; getch
     end
  end (*getsym*);

 procedure gen(x: integer; y,z: integer);
  begin if cx > cxmax then
             begin writeln(' program too long'); (*goto 99 halt(1)*)
             end;
     code[cx].f := x; code[cx].l := y; code[cx].a := z;
     if ((feedbacklevel = 2) or (feedbacklevel= 3)) then
         begin
             write('                           code generated ');
             for i:=1 to 3 do write(mnemonic[code[cx].f][i]);
             writeln(' ',code[cx].l, ' ',code[cx].a,' cx = ',cx);
         end;
     cx := cx + 1
 end (*gen*);

  procedure getindex(s1: symset);
  var i,j:integer;
  begin
     j:=0;
     for i:=1 to 30 do if ((s1[i] = 0) and (j=0)) then j :=i;
     addindex :=j;
  end;(* getindex *)

  procedure test(s1,s2: symset; n: integer);
  var i,found :integer;
  begin
      found :=0;
      for i:=1 to 30 do if sym = s1[i] then found :=1;
      if found = 0 then
          begin
  	    error(n);
  	    getindex(s1);
              for i:=addindex to 30 do s1[i] := s2[i-addindex+1];
  	    found := 0;
 	    while found = 0 do
 	       begin
  	           getsym;
 		   for i:=1 to 30 do if sym = s1[i] then found :=1;
 	       end
           end
  end; (*test*)

  (*
  545  begin if not(sym in s1) then
      545          begin error(n); s1 := s1 + s2;
      545             while not(sym in s1) do getsym
      545          end
      545  end*) (*test*)

 procedure block(lev,tx,addDX: integer; fsys: symset);
     var dx: integer;     (*data allocation index*)
        tx0: integer;     (*initial table index*)
        cx0: integer;     (*initial code index*)
        tempdx: integer;
        varCount: integer;
        addsym: symset;
        found: integer;
     procedure enter(k: integer);
     begin (*enter object1 into table*)
        tx := tx + 1;
        table[tx].name := id; table[tx].kind := k;
  	 case k of
           constant: begin if num > nmax then (*BPW - shouldn't happen!*)
                         begin error(30); num :=0 end;
                        table[tx].val := num;
			if ((feedbacklevel = 2) or (feedbacklevel =3))then
  		      begin
  			 write('                          Name =');
  			 for i:=1 to al do write(id[i]);
  			 write(' kind = constant');
  		         writeln(' number = ', table[tx].val, ' tx= ',tx, ' dx= ',dx);
  		      end;
                     end;
           varible: begin table[tx].level := lev; table[tx].adr := dx; dx := dx + 1;
                    if ((feedbacklevel = 2) or (feedbacklevel =3))then
  		      begin
  			 write('                          Name =');
  			 for i:=1 to al do write(id[i]);
  			 write(' kind = varible');
  		         writeln(' level = ',lev,' adr = ',dx-1,' tx= ',tx, ' dx= ',dx);
  	  	      end;
  		  end;
           proc: 	begin
  	 	table[tx].level := lev;
  		if ((feedbacklevel = 2) or (feedbacklevel =3))then
 		      begin
  			 write('                          Name =');
  			 for i:=1 to al do write(id[i]);
  			 write(' kind = procedure');
  		         writeln(' lev = ', lev, ' tx = ', tx, ' dx= ',dx);
  		      end;
  		end;
           (* shouldn't be called for instream or outstream*)
           end
     end (*enter*);

     function position(id: alfa): integer;
        var i: integer;
     begin (*find indentifier id in table*)
        table[0].name := id; i := tx;
        wordtest:=1;
        found:=0;
        for i:=tx downto 0 do
            begin
  	     checkword(table[i].name,id);
  	     if ((wordtest = 0) and (found=0)) then
  	         begin position:=i; found:=1
  		 end;
  	  end;
     end (*position*);

     procedure constdeclaration;
     begin if sym = ident then
        begin getsym;
           if ((sym=eql)or(sym=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(varible); getsym
             end else error(4)
     end (*vardeclaration*);

     procedure listcode;
        var i,j: integer;
     begin (*list code generated for this block*)
        for i := cx0 to cx-1 do
              (* writeln(i:5, mnemonic[f]:5, 1:3, a:5) *)
              if ((feedbacklevel = 1) or (feedbacklevel =3))then
  	        begin
  		    write(i:5,'  ');
  		    for j:=1 to 3 do write(mnemonic[code[i].f][j]);
  		    writeln(' ',code[i].l:3, code[i].a:5); (*corrected line above BPW*)
  		end;
     end (*listcode*);

     procedure statement(fsys: symset);
        var i, cx1, cx2: integer;
            addsym: symset;
        procedure expression(fsys: symset);
           var addop: integer;
            addsym: symset;
           procedure term(fsys: symset);
              var mulop: integer;
            addsym: symset;
              procedure factor(fsys: symset);
                 var i: integer;
  	           addsym: symset;
              begin test(facbegsys, fsys, 24);
                 while ((sym = ident) or (sym = number) or (sym = lparen)) do
                 begin
                    if sym = ident then
                    begin i:= position(id);
                       if i = 0 then error(11) else
                       case table[i].kind of
                          constant: gen(lit, 0, table[i].val);
                          varible: gen(lod, lev-table[i].level, table[i].adr);
                          proc: error(21);
                          instream: gen(rdi, 0, 0); (*bpw*)
                          outstream: error(21) (*bpw*)
                       end;
                       getsym
                    end else
                    if sym = number then
                    begin if num >  nmax then (*BPW - shouldn't happen*)
	     		begin error(30); num := 0
                             end;
                       gen(lit, 0, num); getsym
                    end else
                    if sym = lparen then
                    begin
  		     getsym;
  		     getindex(fsys);
  		     fsys[addindex]:=rparen;
  		     expression(fsys);
  		     getindex(fsys);
  		     fsys[addindex -1]:=0;
                     if sym = rparen then getsym else error(22)
                    end;
  		  addsym[1] := lparen;
                    if varCount = 0 then test(fsys, addsym, 23);
  		  addsym[1] := 0;
                    (*test(fsys, [lparen], 23);*)
                 end
              end (*factor*);

           begin (*term*)
 	    getindex(fsys);
  	    fsys[addindex]:=times;
  	    fsys[addindex+1]:=slash;
  	    factor(fsys);
  	    getindex(fsys);
  	    fsys[addindex -1]:=0;
  	    fsys[addindex -2]:=0;
              while ((sym = times)or (sym = slash)) do
              begin
  	         mulop:=sym;
  		 getsym;
  		 getindex(fsys);
  	         fsys[addindex]:=times;
  	         fsys[addindex+1]:=slash;
  	         factor(fsys);
  		 getindex(fsys);
  	         fsys[addindex -1]:=0;
  	         fsys[addindex -2]:=0;
                if mulop=times then gen(opr,0,4) else gen(opr,0,5)
               end
           end (*term*);
        begin (*expression*)
          if ((sym = plus) or (sym = minus)) then
              begin
  	       addop := sym;
  	       getsym;
  	       getindex(fsys);
  	       fsys[addindex] := plus;
  	       fsys[addindex +1] := minus;
  	       term(fsys);
  	       getindex(fsys);
  	       fsys[addindex -1] := 0;
  	       fsys[addindex -2] := 0;
                 if addop = minus then gen(opr, 0,1)
              end else
  	        begin
  	           getindex(fsys);
  	           fsys[addindex] := plus;
  	           fsys[addindex +1] := minus;
  		   term(fsys);
  	           getindex(fsys);
  	           fsys[addindex -1] := 0;
  	           fsys[addindex -2] := 0;
  		end;
           while ((sym=plus)or(sym=minus)) do
              begin
  	       addop := sym;
 	       getsym;
  	       getindex(fsys);
 	       fsys[addindex] := plus;
  	       fsys[addindex +1] := minus;
  	       term(fsys);
  	       getindex(fsys);
  	       fsys[addindex -1] := 0;
  	       fsys[addindex -2] := 0;
  	       if addop=plus then gen(opr,0,2) else gen(opr,0,3)
              end
        end (*expression*);

        procedure condition(fsys: symset);
          var relop: integer;
        begin
         if sym  = oddsym then
           begin getsym; expression(fsys); gen(opr, 0, 6);
           end else
           begin
  	    getindex(fsys);
  	    fsys[addindex] := eql;
  	    fsys[addindex +1] := neq;
  	    fsys[addindex +2] := lss;
  	    fsys[addindex +3] := gtr;
 	    fsys[addindex +4] := leq;
  	    fsys[addindex +5] := geq;
  	    expression(fsys);
  	    getindex(fsys);
  	    fsys[addindex -1] := 0;
  	    fsys[addindex -2] := 0;
  	    fsys[addindex -3] := 0;
  	    fsys[addindex -4] := 0;
  	    fsys[addindex -5] := 0;
  	    fsys[addindex -6] := 0;
              if not((sym = eql) or (sym = neq) or (sym = lss) or (sym = leq) or (sym = gtr) or (sym = geq)) then
                 error(20) else
              begin relop := sym; 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);
           if i = 0 then error(11) else
          (*BPW - modified for streams*)
           if (table[i].kind <> varible)
           and (table[i].kind <> outstream) then
              begin (*assignment to non-varible*) error(12); i := 0
              end;
           getsym; if sym = becomes then getsym else error(13);
           expression(fsys);
           if i <> 0 then
               if table[i].kind = varible then
                gen(sto, lev-table[i].level, table[i].adr)
               else gen(wro,0,0) (*BPW, for outstream*)
       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
                    if table[i].kind=proc then 
 		  begin 
  		    (* gen(cal, lev-level, adr);*)
  		     getsym;
  		     procName := table[i].name;
  		     varCount :=0;
 		     if table[i].vars <> 0 then
  		     	begin
  		     	    if sym <> lparen then error(6);
  		     	    getsym;
  		  	    while varCount <> table[position(procName)].vars do 
  				begin
  			    	    varCount := varCount+1;
  			    	    expression(fsys);
  			    	    if sym = comma then getsym;
  				end;
  			    tempdx := varCount;
 			    if sym <> rparen then error(6) else getsym;
  		         end;
  		     gen(cal, lev-table[i].level, table[i].adr);
  		     gen(pop, 0, varCount);
  		     varCount :=0;
  		   end
                    else error(15);
              end
        end else
        if sym = ifsym then
        begin 
           getsym;
  	 getindex(fsys);
  	 fsys[addindex]:=thensym;
  	 fsys[addindex +1]:=dosym;
  	 condition(fsys);
  	 getindex(fsys);
  	 fsys[addindex -1]:=0;
  	 fsys[addindex -2]:=0;
           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; 
 	 getindex(fsys);
  	 fsys[addindex]:=semicolon;
  	 fsys[addindex +1]:=endsym;
  	 statement(fsys);
  	 getindex(fsys);
  	 fsys[addindex -1]:=0;
  	 fsys[addindex -2]:=0;
           while ((sym = semicolon)or(sym=beginsym)or(sym=callsym)or(sym=ifsym)or(sym=whilesym)) do
           begin
              if sym = semicolon then getsym else error(10);
  	    getindex(fsys);
  	    fsys[addindex]:=semicolon;
  	    fsys[addindex +1]:=endsym;
              statement(fsys);
  	    getindex(fsys);
  	    fsys[addindex -1]:=0;
  	    fsys[addindex -2]:=0;
           end;
           if sym = endsym then getsym else error(17)
        end else
        if sym = whilesym then
       begin cx1 := cx; 
           getsym;
  	 getindex(fsys);
  	 fsys[addindex]:=dosym;
  	 condition(fsys);
  	 getindex(fsys);
  	 fsys[addindex -1]:=0;
           cx2 := cx; gen(jpc, 0, 0);
           if sym = dosym then getsym else error(18);
           statement(fsys); gen(jmp, 0, cx1); code[cx2].a := cx
        end;
        addsym[1]:=0;
        test(fsys, addsym, 19);
     end (*statement*);
   
  begin (*block*) 
     dx:=3 + addDX; 
     tx0:=tx - addDX; 
     table[tx - addDX].adr:=cx; 
     gen(jmp,0,0);
     varCount:=0;
     (*if addDX > 0 then else
      2176     	begin
      2176  	    backCounter:= 1;
      2176  	    while addDX > 0 do
      2176  	    	begin
      2176  		gen(mov, addDX, table[tx0 + backCounter].adr);
      2176  		addDX := addDX - 1;
      2176  		backCounter := backCounter +1;
      2176  		end;
      2176  	end;*)
     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(proc);
  	    	  procName :=id;
           	  varCount :=0;
  	    	  getsym;
  		  tempdx := dx;
  		  if sym = lparen then
  		  begin
  		      getsym;
  		      (*lev := lev +1;*)
  		      if sym <> rparen then 
  		      (*while sym <> rparen do*)
  		         begin
  		         lev := lev +1;
  			 dx:=3;
 		         vardeclaration;
  	       	         varCount := varCount + 1;
  			 while sym = comma do
  			     begin 
  			     getsym; 
  			     vardeclaration;
  	       	             varCount := varCount + 1;
  			     end
  			end;
  			lev := lev - 1;
  			
  			table[position(procName)].vars := varCount;
  			if ((feedbacklevel = 2) or (feedbacklevel =3))then writeln('       vars = ',table[position(procName)].vars);
  			getsym;
  			procName[1] := ' ';
  		  end
  		  else table[position(procName)].vars :=0;(*error(6)*)
              end
           else error(4);
           if sym = semicolon then getsym else error(5);
            getindex(fsys);
  	  fsys[addindex]:=semicolon;
  	  block(lev+1, tx,varCount, fsys);
            getindex(fsys);
  	  fsys[addindex -1]:=0;
  	 dx :=tempdx;
           if sym = semicolon then
              begin 
  	        getsym;
  	        addsym[1] := beginsym;
  	        addsym[2] := callsym;
  	        addsym[3] := ifsym;
  	        addsym[4] := whilesym;
 	        addsym[5] := ident;
  	        addsym[6] := procsym;
  		test(addsym,fsys,6);
  	        addsym[1] := 0;
  	        addsym[2] := 0;
  	        addsym[3] := 0;
  	        addsym[4] := 0;
  	        addsym[5] := 0;
  	        addsym[6] := 0;
              end
           else error(5)
        end;
        addsym[1] := beginsym;
        addsym[2] := callsym;
        addsym[3] := ifsym;
        addsym[4] := whilesym;
        addsym[5] := ident;
        test(addsym, declbegsys, 7);
        addsym[1] := 0;
        addsym[2] := 0;
        addsym[3] := 0;
        addsym[4] := 0;
        addsym[5] := 0;
     until not((sym = constsym) or (sym = varsym) or (sym = procsym));
     if ((feedbacklevel = 2) or (feedbacklevel =3))then writeln('tx0 = ',table[tx0].adr,' cx = ',cx);
     code[table[tx0].adr].a := cx;
        begin table[tx0].adr := cx; (*start adr of code*)
       end;
     cx0 := cx; gen(int, 0, dx);
     if table[tx0].vars > 0 then
     	begin
  	    varCount:=table[tx0].vars;
  	    backCounter:= 1;
  	    while varCount > 0 do
  	    	begin
  		gen(mov, varCount, table[tx0+backCounter].adr);
  		varCount := varCount - 1;
		backCounter := backCounter +1;
  		end;
  	end;
     getindex(fsys);
     fsys[addindex]:=semicolon;
     fsys[addindex +1]:=endsym;
     statement(fsys);
     getindex(fsys);
     fsys[addindex -1]:=0;
     fsys[addindex -2]:=0;
     gen(opr, 0, 0); (*return*)
     addsym[1]:=0;
     test(fsys, addsym, 8);
     if ((feedbacklevel = 1) or (feedbacklevel = 3)) then listcode; (*BPW*)
 end (*block*);
   
  procedure interpret;
     const stacksize = 5000;
     var p,b,t: integer; (*program-, base-, topstack-registers*)
       i: integer; (*instruction register code reference *)
       s: array [1..stacksize] of integer; (*datastore*)
       inOpen: boolean;
  
    function base(l: integer): integer;
      var b1: integer;
     begin b1 := b; (*find base l levels down*)
        while l > 0 do
           begin 
  	     (*write(' base(l) called with l = ',l);*)
  	     b1 := s[b1]; l := l - 1
           end;
        (*writeln(' returned ',b1);*)
        base := b1
     end (*base*);
   
  begin writeln(' start pl/0');
     inOpen:=true; (*BPW*)
     t := 0; b := 1; p := 0;
     s[1] := 0; s[2] := 0; s[3] := 0;
     repeat i := p; p := p + 1;
        begin
       (* writeln('             ',f,'  ',l,' ',a);*)
        case code[i].f of
        lit: begin t := t + 1; s[t] := code[i].a
             end;
        opr: case code[i].a of (*operator*)
             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;
            end;
        mov: begin
        		s[b + code[i].a] :=s[b - code[i].l];(*Go l points below call and store in Varibale location a*)
  	   end;
        pop: begin
        		t :=( t - (code[i].a));
  	   end;
        lod: begin t := t + 1; s[t] := s[base(code[i].l) + code[i].a]
             end;
        sto: begin 
               s[base(code[i].l)+code[i].a] := s[t]; 
               (*writeln(s[t]); BPW*)
               t := t - 1
             end;
        cal: begin (*generate new block mark*)
                (*s[t + 1] := base(l); s[t + 2] := b; s[t + 3] := p;*)
                s[t + 1] := base(code[i].l); s[t + 2] := b; s[t + 3] := p;
                b := t + 1; p := code[i].a
             end;
        int: t := t + code[i].a;
        jmp: p := code[i].a;
        jpc: begin if s[t] = 0 then p := code[i].a; t := t - 1
             end;
        rdi: (* BPW - see lod *)
            begin
              if not(inOpen) then begin writeln('in abort'); (*halt(1)*) end;
               t := t + 1;
               write('? ');
               read(s[t]);
               if s[t]= (-999999) then
                 inOpen:=false
             end;
        wro: (* BPW - see sto *)
             begin
              writeln('! ',s[t]);
               t := t - 1;
             end
  	   end
        end (*with, case*)
     until p = 0;
     write(' end pl/0');
  end (*interpret*);
  
  begin (*main program*)
   (*  for i := 0 to 255 do ssym[i] := nul;*)
	 word[1][1]:='b';
	 word[1][2]:='e';
	 word[1][3]:='g';
         word[1][4]:='i';
         word[1][5]:='n';
        for i:=6 to al do word[1][i]:=' ';
     word[2][1]:='c';
         word[2][2]:='a';
         word[2][3]:='l';
         word[2][4]:='l';
         for i:=5 to al do word[2][i]:=' ';
     word[3][1]:='c';
         word[3][2]:='o';
         word[3][3]:='n';
         word[3][4]:='s';
         word[3][5]:='t';
         for i:=6 to al do word[3][i]:=' ';
     word[4][1]:='d';
         word[4][2]:='o';
         for i:=3 to al do word[4][i]:=' ';
     word[5][1]:='e';
         word[5][2]:='n';
         word[5][3]:='d';
         for i:=4 to al do word[5][i]:=' ';
     word[6][1]:='i';
         word[6][2]:='f';
         for i:=3 to al do word[6][i]:=' ';
     word[7][1]:='o';
         word[7][2]:='d';
         word[7][3]:='d';
         for i:=4 to al do word[7][i]:=' ';
     word[8][1]:='p';
         word[8][2]:='r';
         word[8][3]:='o';
         word[8][4]:='c';
         word[8][5]:='e';
         word[8][6]:='d';
         word[8][7]:='u';
         word[8][8]:='r';
         word[8][9]:='e';
         word[8][10]:=' ';
         word[9][1]:='t';
         word[9][2]:='h';
         word[9][3]:='e';
         word[9][4]:='n';
         for i:=5 to al do word[9][i]:=' ';
     word[10][1]:='v';
         word[10][2]:='a';
         word[10][3]:='r';
         for i:=4 to al do word[10][i]:=' ';
     word[11][1]:='w';
         word[11][2]:='h';
         word[11][3]:='i';
         word[11][4]:='l';
         word[11][5]:='e';
         for i:=6 to al do word[11][i]:=' ';
     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] := thensym;      wsym[10] := varsym;
     wsym[11] := whilesym;
     ssym[ord('+')] := plus;       ssym[ord('-')] := minus;
     ssym[ord('*')] := times;      ssym[ord('/')] := slash;
     ssym[ord('(')] := lparen;     ssym[ord(')')] := rparen;
     ssym[ord('=')] := eql;        ssym[ord(',')] := comma;
     ssym[ord('.')] := period;     ssym[ord('#')] := neq;
     ssym[ord('<')] := lss;        ssym[ord('>')] := gtr;
     ssym[ord('[')] := leq;        ssym[ord(']')] := geq;
     ssym[ord(';')] := semicolon;
     mnemonic[lit][1]:='l';
     mnemonic[lit][2]:='i';
     mnemonic[lit][3]:='t';
     
     mnemonic[opr][1]:='o';
     mnemonic[opr][2]:='p';
     mnemonic[opr][3]:='r';
     
     mnemonic[lod][1] := 'l';
     mnemonic[lod][2] := 'o';
     mnemonic[lod][3] := 'd';
     
     mnemonic[sto][1] := 's';
     mnemonic[sto][2] := 't';
     mnemonic[sto][3] := 'o';
     
     mnemonic[cal][1] := 'c';
     mnemonic[cal][2] := 'a';
     mnemonic[cal][3] := 'l';
     
     mnemonic[int][1] := 'i';
     mnemonic[int][2] := 'n';
     mnemonic[int][3] := 't';
     
     mnemonic[jmp][1] := 'j';
     mnemonic[jmp][2] := 'm';
     mnemonic[jmp][3] := 'p';
     
     mnemonic[jpc][1] := 'j';
     mnemonic[jpc][2] := 'p';
     mnemonic[jpc][3] := 'c';
     
     mnemonic[rdi][1] := 'r';
     mnemonic[rdi][2] := 'd';
     mnemonic[rdi][3] := 'i';
     
     mnemonic[wro][1] := 'w';
     mnemonic[wro][2] := 'r';
     mnemonic[wro][3] := 'o';
     
     mnemonic[pop][1] := 'p';
     mnemonic[pop][2] := 'o';
     mnemonic[pop][3] := 'p';
     
     mnemonic[mov][1] := 'm';
     mnemonic[mov][2] := 'o';
     mnemonic[mov][3] := 'v';
     
     declbegsys[1]:= constsym;
     declbegsys[2]:= varsym;
     declbegsys[3]:= procsym;
     statbegsys[1]:= beginsym;
     statbegsys[2]:= callsym;
     statbegsys[3]:= ifsym;
     statbegsys[4]:= whilesym;
     facbegsys[1]:= ident;
     facbegsys[2]:= number;
     facbegsys[3]:= lparen;
     (*page(output);*) err := 0;
     cc := 0; cx := 0; ll := 0; ch := ' '; kk := al;  getsym;
     (*for in and out streams*)
     table[1].name[1]:='i';
     table[1].name[2]:='n';
     for i:=3 to al do table[1].name[i]:=' ';
     table[1].kind:=instream;
     table[2].name[1]:='o';
     table[2].name[2]:='u';
     table[2].name[3]:='t';
     for i:=4 to al do table[2].name[i]:=' ';
     table[2].kind:=outstream;
     (*block(0, 0, [period]+declbegsys+statbegsys);*)
     addsym[1]:= period;
     addsym[2]:= constsym;
     addsym[3]:= varsym;
     addsym[4]:= procsym;
     addsym[5]:= beginsym;
     addsym[6]:= callsym;
     addsym[7]:= ifsym;
     addsym[8]:= whilesym;
     block(0, 2,0, addsym);
     if sym <> period then error(9);
     if err=0 then interpret else write(' errors in pl/0 program');
  writeln
end.
 procedure iloop(i); 
   procedure jloop(j);
      procedure kloop(k);
        begin 
         k:=k+1;
         out:=i+j+k;
         if k<3 then
           call kloop(k);
         if k=3 then
           call jloop(j)
       end; 
      begin 
       j:=j+10;
       if j<40 then
         call kloop(0);
       if j=40 then 
         call iloop(i)
     end; 
    begin
     i:=i+100;
     if i<400 then
       call jloop(0)
   end; 
  begin 
   call iloop(0)
 end.