source: branches/Pascal Compiler/UVirtualMachine.pas

unit UVirtualMachine;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Contnrs;

type
  TVirtualProcessor = class;

  TProcessorInstruction = class
    DataWidth: Integer;
    FOwner: TVirtualProcessor;
  end;

  // Instruction operands

  TInstructionOperand = class
    Value: Integer;
  end;

  TOperandNonConstant = class(TInstructionOperand)
  end;

  TOperandConstant = class(TInstructionOperand)
  end;

  TOperandAddress = class(TOperandNonConstant)
  end;

  TOperandIndirectAddress = class(TOperandNonConstant)
  end;

  // Data manipulation

  TInstructionCopy = class(TProcessorInstruction)
    Source: TInstructionOperand;
    Destination: TOperandNonConstant;
    procedure Execute;
  end;

  // Arithmetic operation

  TInstructionIncrement = class(TProcessorInstruction)
    Address: TOperandNonConstant;
    procedure Execute;
  end;

  TInstructionDecrement = class(TProcessorInstruction)
    Address: TOperandNonConstant;
    procedure Execute;
  end;

  // Program control

  TInstructionJump = class(TProcessorInstruction)
    Address: Integer;
    procedure Execute;
  end;

  TInstructionCall = class(TProcessorInstruction)
    Address: Integer;
    procedure Execute;
  end;

  TInstructionReturn = class(TProcessorInstruction)
    procedure Execute;
  end;

  // Stact manipulation

  TInstructionPush = class(TProcessorInstruction)
    Address: TOperandNonConstant;
    procedure Execute;
  end;

  TInstructionPop = class(TProcessorInstruction)
    Address: TOperandNonConstant;
    procedure Execute;
  end;

  TExecutionThread = class(TThread)
  public
    Parent: TVirtualProcessor;
    procedure Execute; override;
  end;

  TVirtualProcessor = class
  private
    ExecutionThread: TExecutionThread;
    function GetAddress(Address: Integer): Integer;
  public
    Memory: array of Byte;
    ProgramCounter: Integer;
    Stack: TStack;
    procedure Start;
    procedure Stop;
    constructor Create;
    destructor Destroy; override;
  end;

implementation

{ TVirtualProcessor }

constructor TVirtualProcessor.Create;
begin
  ExecutionThread := TExecutionThread.Create(True);
  ExecutionThread.Parent := Self;
  Stack := TStack.Create;
end;

destructor TVirtualProcessor.Destroy;
begin
  Stack.Free;
  ExecutionThread.Free;
end;

function TVirtualProcessor.GetAddress(Address: Integer): Integer;
begin
  Result := Memory[Address] or (Memory[Address + 1] shl 8) or
    (Memory[Address + 2] shl 16) or (Memory[Address + 3] shl 24);
end;

procedure TVirtualProcessor.Start;
begin
  ExecutionThread.Resume;
end;

procedure TVirtualProcessor.Stop;
begin
  ExecutionThread.Suspend;
end;

{ TexecutionThread }

procedure TExecutionThread.Execute;
begin
  inherited;
  with Parent do
  begin
    ProgramCounter := 0;
    repeat
      //case Memory[ProgramCounter] of

      //end;

    until Terminated;
  end;
end;

{ TInstructionIncrement }

procedure TInstructionIncrement.Execute;
begin
  if Address is TOperandAddress then
    Inc(FOwner.Memory[Address.Value])
  else
  if Address is TOperandIndirectAddress then
    Inc(FOwner.Memory[FOwner.GetAddress(Address.Value)]);
  Inc(FOwner.ProgramCounter);
end;

{ TInstructionCopy }

procedure TInstructionCopy.Execute;
begin
  if Destination is TOperandAddress then begin
    if Source is TOperandConstant then
      FOwner.Memory[Destination.Value] := Source.Value
    else
    if Source is TOperandAddress then
      FOwner.Memory[Destination.Value] := FOwner.Memory[Source.Value]
    else
      FOwner.Memory[Destination.Value] :=
        FOwner.Memory[FOwner.GetAddress(Source.Value)];
  end else
  if Destination is TOperandIndirectAddress then begin
    if Source is TOperandConstant then
      FOwner.Memory[FOwner.GetAddress(Destination.Value)] := Source.Value
    else
    if Source is TOperandAddress then
      FOwner.Memory[FOwner.GetAddress(Destination.Value)] := FOwner.Memory[Source.Value]
    else
      FOwner.Memory[FOwner.GetAddress(Destination.Value)] :=
        FOwner.Memory[FOwner.GetAddress(Source.Value)];
  end else
    raise Exception.Create('COPY: Can''t copy to constant!');
  Inc(FOwner.ProgramCounter);
end;

{ TInstructionJump }

procedure TInstructionJump.Execute;
begin
  FOwner.ProgramCounter := Address;
end;

{ TInstructionCall }

procedure TInstructionCall.Execute;
begin
  FOwner.Stack.Push(Pointer(FOwner.ProgramCounter));
  FOwner.ProgramCounter := Address;
end;

{ TInstructionReturn }

procedure TInstructionReturn.Execute;
begin
  FOwner.ProgramCounter := Integer(FOwner.Stack.Pop);
end;

{ TInstructionPush }

procedure TInstructionPush.Execute;
begin
  if Address is TOperandAddress then
    //FOwner.Stack.Push(FOwner.Memory[Address.Value])
  else
  if Address is TOperandIndirectAddress then
    //FOwner.Stack.Push(FOwner.Memory[FOwner.GetAddress(Address.Value)]);
  Inc(FOwner.ProgramCounter);
end;

{ TInstructionDecrement }

procedure TInstructionDecrement.Execute;
begin
  if Address is TOperandAddress then
    Dec(FOwner.Memory[Address.Value])
  else
  if Address is TOperandIndirectAddress then
    Dec(FOwner.Memory[FOwner.GetAddress(Address.Value)]);
  Inc(FOwner.ProgramCounter);
end;

{ TInstructionPop }

procedure TInstructionPop.Execute;
begin
  if Address is TOperandAddress then
    //FOwner.Memory[Address.Value] := FOwner.Stack.Pop
  else
  if Address is TOperandIndirectAddress then
    //FOwner.Memory[FOwner.GetAddress(Address.Value)] := FOwner.Stack.Pop;
  Inc(FOwner.ProgramCounter);
end;

end.