P-code Machine

procedure interpret;

   const stacksize = 500;

   var p,b,t: integer; {program-, base-, topstack-registers}

      i: instruction; {instruction register}

      s: array  {Link without Title}  of integer; {datastore}

   function base(l: integer): integer;

      var b1: integer;

   begin b1 := b; {find base l levels down}

      while l > 0 do

         begin b1 := s {Link without Title} ; l := l - 1

         end;

      base := b1

   end {base};



begin writeln(' start pl/0');

   t := 0; b := 1; p := 0;

   s := 0; s[2  := 0; s[3] := 0;

   repeat i := code {Link without Title} ; p := p + 1;

      with i do

      case f of

      lit: begin t := t + 1; s {Link without Title}  := a end;

      opr: case a of {operator}

           0: begin {return}

                 t := b - 1; p := s + 3 ; b := s + 2 ;

              end;

           1: s := -s[t ;

           2: begin t := t - 1; s := s[t  + s + 1  end;

           3: begin t := t - 1; s := s[t  - s + 1  end;


 s + 1  end;


           5: begin t := t - 1; s := s[t  div s + 1  end;



           6: s := ord(odd(s[t ));

           8: begin t := t - 1; s := ord(s[t  = s + 1 ) end;

           9: begin t := t - 1; s := ord(s[t  <> s + 1 ) end;

          10: begin t := t - 1; s := ord(s[t  < s + 1 ) end;

          11: begin t := t - 1; s := ord(s[t  >= s + 1 ) end;

          12: begin t := t - 1; s := ord(s[t  > s + 1 ) end;

          13: begin t := t - 1; s := ord(s[t  <= s + 1 ) end;

          end;

      lod: begin t := t + 1; s := s[base(l) + a  end;

      sto: begin s := s[t ; writeln(s[t]); t := t - 1 end;

      cal: begin {generate new block mark}

              s + 1  := base(l); s + 2  := b; s + 3  := p;

              b := t + 1; p := a

           end;

      int: t := t + a;

      jmp: p := a;

      jpc: begin if s {Link without Title}  = 0 then p := a; t := t - 1 end

      end {with, case}

   until p = 0;

   write(' end pl/0');

end {interpret};