(*************************************************************************

:Program.       PL0Interpreter.mod
:Contents.      Code-Interpreter for PL0-Complier (virtuell Computer)
:Author.        N. With, ported to Oberon by hartmut Goebel
:Language.      Oberon
:Translator.    Amiga Oberon

:Imports.       TextWindows (hartmut Goebel)

*************************************************************************)

MODULE PL0Interpreter;

IMPORT
  NoGuru,
  tw: TextWindows,
  sys: SYSTEM;

CONST
  maxfct* = 7;
  maxlev* = 15;
  maxadr* = 1023;

  ret*=0; neg*=1; plus*=2; minus*=3; times*=4;div*=5; odd*=6; nop*=7;
  eql*=8; neq*=9; lss*=10; geq*=11; gtr*=12; leq*=13;
  readVar*=14; writeVar*=15;

TYPE
  Instruction* = RECORD
    f*: SHORTINT; (* function *)
    l*: INTEGER;  (* level *)
    a*: INTEGER;  (* address *)
  END;

  MnemonicList = ARRAY maxfct+1,5 OF CHAR;

CONST
  mnemonic* = MnemonicList (
    "  LIT","  OPR","  LOD","  STO","  CAL","  INT","  JMP","  JPC");
       LIT*=0; OPR*=1; LOD*=2; STO*=3; CAL*=4; INT*=5; JMP*=6; JPC*=7;
VAR
  code*: ARRAY maxadr+1 OF Instruction;
  win: tw.TxtWinPtr;
  i: Instruction;

PROCEDURE Interpret*;
CONST
  stacksize = 1000;
VAR
  p,b,t: INTEGER; (* Program-, Base-, Stack-Registers *)
  s: ARRAY stacksize OF INTEGER; (* data store *)
  x: LONGINT;

  PROCEDURE base(l: INTEGER): INTEGER;
  (* find base address, l levels down *)
  VAR
    b1: INTEGER;
  BEGIN
    b1 := b;
    WHILE l > 0 DO
      b1 := s[b1]; DEC(l);
    END;
    RETURN b1;
  END base;

BEGIN
  tw.ClrHome(win);
  t := 0; b := 0; p := 0;
  s[1] := 0; s[2] := 0; s[3] := 0;
  REPEAT
    i := code[p];
    INC(p);
    CASE i.f OF
      LIT: INC(t); s[t] := i.a; |
      OPR: CASE i.a OF (* operators *)
           ret: (* RET *) t := b-1; p := s[t+3]; b := s[t+2] |
           neg:   s[t] := -s[t] |
           plus:  DEC(t); s[t] := s[t]+s[t+1] |
           minus: DEC(t); s[t] := s[t]-s[t+1] |
           times: DEC(t); s[t] := s[t]*s[t+1] |
           div:   DEC(t); s[t] := s[t] DIV s[t+1] |
           odd:   s[t] := sys.VAL(SHORTINT,ODD(s[t])) |
           nop: |
           eql: DEC(t); s[t] := sys.VAL(SHORTINT,s[t] = s[t+1]) |
           neq: DEC(t); s[t] := sys.VAL(SHORTINT,s[t] # s[t+1]) |
           lss: DEC(t); s[t] := sys.VAL(SHORTINT,s[t] < s[t+1]) |
           geq: DEC(t); s[t] := sys.VAL(SHORTINT,s[t] >= s[t+1]) |
           gtr: DEC(t); s[t] := sys.VAL(SHORTINT,s[t] > s[t+1]) |
           leq: DEC(t); s[t] := sys.VAL(SHORTINT,s[t] <= s[t+1]) |
           readVar: INC(t);
              tw.Inversid(win);
              tw.Write(win,">");
              IF tw.ReadInt(win,x) THEN s[t] := SHORT(x) END;
              tw.Normal(win); |
           writeVar: tw.WriteInt(win,s[t],7); tw.WriteLn(win);
              DEC(t);
           END; |
      LOD: INC(t); s[t] := s[base(i.l)+i.a] |
      STO: s[base(i.l)+i.a] := s[t]; DEC(t); |
      CAL: (* generate new block mark *)
           s[t+1] := base(i.l); s[t+2] := b; s[t+3] := p;
           b := t+1; p := i.a; |
      INT: t := t+i.a; |
      JMP: p := i.a; |
      JPC: IF s[t]=0 THEN p := i.a; END;
         DEC(t);
    END;
  UNTIL p = 0;;
END Interpret;


BEGIN
 win := tw.OpenTextWin("RESULT",408,110,204,140);
 IF (win=NIL) THEN HALT(20) END;

CLOSE
  IF win # NIL THEN tw.CloseTextWin(win); END;
END PL0Interpreter.