source: branches/virtualcpu/UMachine.pas

unit UMachine;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Math;

type
  //TAddrInt = Int8;
  TAddrInt = Int16;
  //TAddrInt = Int32;
  //TAddrInt = Int64;
  TDataInt = Int16;
  //TDataInt = Int16;
  //TDataInt = Int32;
  //TDataInt = Int64;

  TRegIndex = TAddrInt;
  TRegSize = Int8;

  TOpcode = (opNop, opHalt, opCopy, opCopyFromMem, opCopyToMem, opCopyConst,
    opSetRegSize, opGetDataSize, opInc, opDec, opJumpRelNotZero);

  TOpcodeHandler = procedure of object;

  { TMachine }

  TMachine = class
  private
    OpcodeTable: array[TOpcode] of TOpcodeHandler;
    procedure OpcodeNop;
    procedure OpcodeHalt;
    procedure OpcodeCopy;
    procedure OpcodeCopyFromMem;
    procedure OpcodeCopyToMem;
    procedure OpcodeCopyConst;
    procedure OpcodeSetRegSize;
    procedure OpcodeGetDataSize;
    procedure OpcodeInc;
    procedure OpcodeDec;
    procedure OpcodeJumpRelNotZero;
    function ReadNext: Integer;
  public
    Registers: array of TDataInt;
    RegisterSize: array of TRegSize;
    Memory: array of Byte;
    IP: TAddrInt;
    Terminated: Boolean;
    procedure Run;
    constructor Create;
  end;

implementation

{ TMachine }

procedure TMachine.Run;
var
  Opcode: TOpcode;
begin
  IP := 0;
  Terminated := False;
  while not Terminated do begin
    if IP >= Length(Memory) then IP := 0;
    Opcode := TOpcode(ReadNext);
    if Opcode <= High(Opcode) then OpcodeTable[Opcode]
      else raise Exception.Create('Unknown opcode: ' + IntToHex(Integer(Opcode), 2));
  end;
end;

constructor TMachine.Create;
var
  I: Integer;
begin
  SetLength(Registers, 16);
  SetLength(RegisterSize, 16);
  for I := 0 to High(RegisterSize) do
    RegisterSize[I] := SizeOf(TDataInt);;

  // Opcode table initialization
  OpcodeTable[opNop] := OpcodeNop;
  OpcodeTable[opHalt] := OpcodeHalt;
  OpcodeTable[opCopy] := OpcodeCopy;
  OpcodeTable[opCopyFromMem] := OpcodeCopyFromMem;
  OpcodeTable[opCopyToMem] := OpcodeCopyToMem;
  OpcodeTable[opCopyConst] := OpcodeCopyConst;
  OpcodeTable[opSetRegSize] := OpcodeSetRegSize;
  OpcodeTable[opGetDataSize] := OpcodeGetDataSize;
  OpcodeTable[opInc] := OpcodeInc;
  OpcodeTable[opDec] := OpcodeDec;
  OpcodeTable[opJumpRelNotZero] := OpcodeJumpRelNotZero;
end;

procedure TMachine.OpcodeNop;
begin

end;

procedure TMachine.OpcodeHalt;
begin
  Terminated := True;
end;

procedure TMachine.OpcodeCopy;
var
  Source: TRegIndex;
  Dest: TRegIndex;
  Size: TRegSize;
begin
  Dest := ReadNext;
  Source := ReadNext;
  Size := Min(RegisterSize[Dest], RegisterSize[Source]);
  Move(Registers[Source], Registers[Dest], Size);
end;

procedure TMachine.OpcodeCopyFromMem;
var
  Source: TRegIndex;
  Dest: TRegIndex;
begin
  Dest := ReadNext;
  Source := ReadNext;
  Move(Memory[Registers[Source]], Registers[Dest], RegisterSize[Dest]);
end;

procedure TMachine.OpcodeCopyToMem;
var
  Source: TRegIndex;
  Dest: TRegIndex;
begin
  Source := ReadNext;
  Dest := ReadNext;
  Move(Registers[Source], Memory[Registers[Dest]], RegisterSize[Source]);
end;

procedure TMachine.OpcodeCopyConst;
var
  Source: TRegIndex;
  Dest: TRegIndex;
begin
  Dest := ReadNext;
  Source := ReadNext;
  Move(Source, Registers[Dest], RegisterSize[Dest]);
end;

procedure TMachine.OpcodeSetRegSize;
var
  Reg: TRegIndex;
  Size: TRegSize;
begin
  Reg := ReadNext;
  Size := Registers[ReadNext];
  if Size <= SizeOf(TDataInt) then
    RegisterSize[Reg] := Size
    else raise Exception.Create('Can''t set register size ' + IntToStr(Size) + '. Max is ' + IntToStr(SizeOf(TDataInt)) + '.');
end;

procedure TMachine.OpcodeGetDataSize;
var
  Dest: TRegIndex;
begin
  Dest := ReadNext;
  Registers[Dest] := SizeOf(TDataInt);
end;

procedure TMachine.OpcodeInc;
var
  Reg: TRegIndex;
begin
  Reg := ReadNext;
  Registers[Reg] := Registers[Reg] + 1;
end;

procedure TMachine.OpcodeDec;
var
  Reg: TRegIndex;
begin
  Reg := ReadNext;
  Registers[Reg] := Registers[Reg] - 1;
end;

procedure TMachine.OpcodeJumpRelNotZero;
var
  RelAddr: TAddrInt;
  Reg: TRegIndex;
begin
  Reg := ReadNext;
  RelAddr := ReadNext;
  if Registers[Reg] <> 0 then
    IP := IP - RelAddr;
end;

function TMachine.ReadNext: Integer;
begin
  if (IP >= 0) and (IP < Length(Memory)) then Result := Memory[IP]
    else raise Exception.Create('Memory access out of range ' + IntToHex(IP, 8));
  Inc(IP);
end;

end.