program interpreter;

type
  EByteCode = (
    RETURN,
    LOAD,
    STORE,
    POP_JMP_IF_FALSE,
    DISCARD_TOP,
    JMP,

    OP_ADD,
    OP_SUB,
    OP_MUL,
    OP_CMPLT,

    PRINTFUNC
  );

  TInstruction = record code:EByteCode; value:Int32; end;
  TInstructions = Array of TInstruction;


function TVariantArray.Pop(): Variant;
var H:Int32;
begin
  H := High(Self);
  Result := Self[H];
  SetLength(Self, H);
end;

procedure TVariantArray.Append(const Value:Variant);
begin
  Self += Value;
end;


procedure Interpret(ops:TInstructions; vars:TVariantArray);
var
  pc,left,right,tmp:Int32;
  stack: TVariantArray;
  instr: TInstruction;
begin
  pc := 0;
  while True do
  begin
    instr := ops[pc];
    inc(pc);
    case instr.code of
      LOAD:
        stack.append(vars[instr.value]);
      STORE:
        vars[instr.value] := stack.pop();
      DISCARD_TOP:
        stack.pop();
      POP_JMP_IF_FALSE:
        if not stack.pop() then
          pc := instr.value;
      JMP:
        pc := instr.value;
      OP_ADD:
        begin
          right := stack.pop();
          left  := stack.pop();
          stack.append( Variant(left + right) );
        end;
      OP_SUB:
        begin
          right := stack.pop();
          left  := stack.pop();
          stack.append( Variant(left - right) );
        end;
      OP_MUL:
        begin
          right := stack.pop();
          left  := stack.pop();
          stack.append( Variant(left * right) );
        end;
      OP_CMPLT:
        begin
          right := stack.pop();
          left  := stack.pop();
          stack.append( Variant(left < right) );
        end;
      PRINTFUNC:
        WriteLn(vars[instr.value]);
      RETURN:
        break;
    end;
  end;

  WriteLn('>>> Variables: ', vars);
end;



(*Lape code:

  start := 0;
  increment := 1;
  stop := 10000;
  repeat
    start := start + increment;
  until not(start < stop);
*)
procedure Test_Iterate(out vars: TVariantArray; out ops:TInstructions);
begin
  vars.Append(0);      //var "a"
  vars.Append(1);      //var "b"
  vars.Append(10);  //var "stop"

  ops := [
      [LOAD,      0], //LOAD a           //from vars
      [LOAD,      1], //LOAD b           //from vars
      [OP_ADD,     ], //tmp := a + b     //pops a and b from stack and adds
      [STORE,     0], //a := tmp         //pops tmp from stack, adds to vars

      [LOAD,      0], //LOAD a           //from vars
      [LOAD,      2], //LOAD stop        //from vars
      [OP_CMPLT,   ], //tmp := a < stop  //pops a and stop from stack and adds
      [POP_JMP_IF_FALSE,  9],            //pop tmp, jump past `JMP`-instruction if false
      [JMP,       0],                    //jumps to 0

      [RETURN,     ]  //done...
    ];
end;

(*Lape code:

  a := 5;
  b := 10;
  c := 100000;
  repeat
    a := a + b;
    b := a * b;
  until not(b < c);
*)
procedure Test_DoLoopThing(out vars: TVariantArray; out ops:TInstructions);
begin
  vars.Append(5);      //var "a"
  vars.Append(10);     //var "b"
  vars.Append(100000); //var "c"

  ops := [
      [LOAD,      0], //LOAD a           //from vars
      [LOAD,      1], //LOAD b           //from vars
      [OP_ADD,     ], //tmp := a + b     //pops a and b from stack and adds
      [STORE,     0], //a := tmp         //pops tmp from stack, adds to vars
      [LOAD,      0], //LOAD a           //from vars
      [LOAD,      1], //LOAD b           //from vars
      [OP_MUL,     ], //tmp := a * b     //pops a and b from stack and muls
      [STORE,     1], //b := tmp         //pops tmp from stack, adds to vars

      [LOAD,      1], //LOAD b           //from vars
      [LOAD,      2], //LOAD c           //from vars
      [OP_CMPLT,   ], //tmp := b < c
      [POP_JMP_IF_FALSE,  13],           //pop tmp, jump past `JMP`-instruction if false
      [JMP,       0],                    //jumps to 0

      [RETURN,     ]  //done...
    ];
end;

(*Lape code:

  a := 0;
  b := 1;
  stop := 100000;
  repeat
    a := a + b;
    writeLn(a);
  until not(a < stop);
*)
procedure Test_Iterate2(out vars: TVariantArray; out ops:TInstructions);
begin
  vars.Append(1);      //var "a"
  vars.Append(1);      //var "b"
  vars.Append(10000);  //var "stop" at

  ops := [
      [LOAD,      0], //LOAD a           //from vars
      [LOAD,      1], //LOAD b           //from vars
      [OP_ADD,     ], //tmp := a + b     //pops a and b from stack and adds
      [STORE,     0], //a := tmp         //pops tmp from stack, adds to vars

      //[PRINTFUNC, 0], //writeLn(a)

      [LOAD,      0], //LOAD a           //from vars
      [LOAD,      2], //LOAD stop        //from vars
      [OP_CMPLT,   ], //tmp := a < stop  //pops a and stop from stack and adds
      [POP_JMP_IF_FALSE,  9],           //pop tmp, jump past `JMP`-instruction if false
      [JMP,       0],                     //jumps to 0

      [RETURN,     ]  //done...
    ];
end;


var
  vars: TVariantArray;
  ops: TInstructions;
  t:Int64;
begin
  //Test_Iterate(vars,ops);
  Test_Iterate2(vars,ops);
  //Test_DoLoopThing(vars,ops);

  t := GetTickCount();
  Interpret(ops,vars);
  WriteLn('Executed in: ', GetTickCount() - t,'ms');
end;