source: branches/CpuSingleSize/Cpu.pas

unit Cpu;

interface

uses
  Classes, SysUtils;

type
  TInstruction = (inNop, inHalt, inSet, inCopy, inInc, inDec, inLoad, inStore,
    inAdd, inSub, inIn, inOut, inJump, inJumpZero, inJumpNotZero, inPush, inPop,
    inCall, inRet, inAnd, inOr, inXor, inShl, inShr, inMul, inDiv, inMod,
    inJumpRel, inLoadIndex, inStoreIndex, inLoadCpu, inStoreCpu, inEi, inDi);

  TInteger = Integer;

  TCpuThread = class;
  TOutputEvent = procedure (Device, Port: TInteger; Value: TInteger) of object;
  TInputEvent = function (Device, Port: TInteger): TInteger of object;

  { TCpuStatus }

  TCpuStatus = packed record
    InterruptEnabled: Boolean;
    UserMode: Boolean;
    UserModeWasActive: Boolean;
    function GetInteger: TInteger;
    procedure SetInteger(Value: TInteger);
  end;

  TIntegerArray = array of TInteger;

  TMemoryBlock = record
    Base: TIntegerArray;
    Size: TInteger;
  end;

  TMemoryBlockIndex = (mbCode, mbData, mbStack, mbInterrupt);
  TInstructionHandler = procedure of object;
  TSystemInterrupt = (siReset, siUserIn, siUserOut, siUserInvalidMemory,
    siPrivilegedInstruction);
  TCpuRegister = (crIP, crSP, crStatusRegister, crUserMemoryBase, crUserMemorySize);

  { TCpu }

  TCpu = class
  private
    FBaseMemory: TMemoryBlock;
    FUserMemory: TMemoryBlock;
    FMemory: TMemoryBlock;
    FRunning: Boolean;
    FThread: TCpuThread;
    FOnInput: TInputEvent;
    FOnOutput: TOutputEvent;
    FNextInterupt: TInteger;
    FHalted: Boolean;
    FTicks: Integer;
    FInstructionHandlers: array[TInstruction] of TInstructionHandler;
    function GetMemory: TIntegerArray;
    procedure InstructionNop;
    procedure InstructionHalt;
    procedure InstructionSet;
    procedure InstructionCopy;
    procedure InstructionLoad;
    procedure InstructionStore;
    procedure InstructionInc;
    procedure InstructionDec;
    procedure InstructionAdd;
    procedure InstructionSub;
    procedure InstructionIn;
    procedure InstructionOut;
    procedure InstructionJump;
    procedure InstructionJumpRel;
    procedure InstructionJumpZero;
    procedure InstructionJumpNotZero;
    procedure InstructionPush;
    procedure InstructionPop;
    procedure InstructionCall;
    procedure InstructionRet;
    procedure InstructionReti;
    procedure InstructionAnd;
    procedure InstructionOr;
    procedure InstructionXor;
    procedure InstructionShl;
    procedure InstructionShr;
    procedure InstructionMod;
    procedure InstructionDiv;
    procedure InstructionMul;
    procedure InstructionLoadIndex;
    procedure InstructionStoreIndex;
    procedure InstructionLoadCpu;
    procedure InstructionStoreCpu;
    procedure InstructionEi;
    procedure InstructionDi;
    procedure SetMemory(AValue: TIntegerArray);
    procedure SetRunning(AValue: Boolean);
    procedure CheckInterreupts;
    procedure Push(Value: TInteger);
    function Pop: TInteger;
    procedure StoreContext;
    procedure LoadContext;
    procedure InitInstructions;
    procedure ActivateUserMode;
    procedure DeactivateUserMode;
  public
    InstructionPointer: TInteger; // Instruction Pointer
    StackPointer: TInteger; // Stack Pointer
    StatusRegister: TCpuStatus; // Status Register
    R: array of TInteger;
    function ReadNext: TInteger;
    procedure WriteNext(Value: TInteger);
    procedure Step;
    procedure Start;
    procedure Stop;
    procedure Reset;
    procedure Interrupt(Index: TSystemInterrupt); overload;
    procedure Interrupt(Index: TInteger); overload;
    constructor Create;
    destructor Destroy; override;
    property Ticks: Integer read FTicks;
    property Memory: TIntegerArray read GetMemory write SetMemory;
    property OnInput: TInputEvent read FOnInput write FOnInput;
    property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
    property Running: Boolean read FRunning write SetRunning;
    property Halted: Boolean read FHalted;
  end;

  { TCpuThread }

  TCpuThread = class(TThread)
    Cpu: TCpu;
    procedure Execute; override;
  end;


implementation

{ TCpuStatus }

function TCpuStatus.GetInteger: TInteger;
begin

end;

procedure TCpuStatus.SetInteger(Value: TInteger);
begin

end;

{ TCpuThread }

procedure TCpuThread.Execute;
begin
  repeat
    if not Cpu.Halted then Cpu.Step
      else Sleep(1);
    Cpu.CheckInterreupts;
  until Terminated;
end;

{ TCpu }

procedure TCpu.SetRunning(AValue: Boolean);
begin
  if FRunning = AValue then Exit;
  if AValue then Start
    else Stop;
end;

procedure TCpu.InstructionNop;
begin
  // No operation
end;

function TCpu.GetMemory: TIntegerArray;
begin
  Result := FBaseMemory.Base;
end;

procedure TCpu.InstructionHalt;
begin
  FHalted := True;
end;

procedure TCpu.InstructionSet;
begin
  R[ReadNext] := ReadNext;
end;

procedure TCpu.InstructionCopy;
begin
  R[ReadNext] := R[ReadNext];
end;

procedure TCpu.InstructionLoad;
begin
  R[ReadNext] := FMemory.Base[R[ReadNext]];
end;

procedure TCpu.InstructionStore;
begin
  FMemory.Base[R[ReadNext]] := R[ReadNext];
end;

procedure TCpu.InstructionInc;
begin
  Inc(R[ReadNext]);
end;

procedure TCpu.InstructionDec;
begin
  Dec(R[ReadNext]);
end;

procedure TCpu.InstructionAdd;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] + R[ReadNext];
end;

procedure TCpu.InstructionSub;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] - R[ReadNext];
end;

procedure TCpu.InstructionIn;
var
  Index: TInteger;
  Device: TInteger;
  Port: TInteger;
begin
  Index := ReadNext;
  Device := R[ReadNext];
  Port := R[ReadNext];
  if StatusRegister.UserMode then begin
    Interrupt(siUserIn);
  end else begin
    if Assigned(FOnInput) then R[Index] := FOnInput(Device, Port);
  end;
end;

procedure TCpu.InstructionOut;
var
  Device: TInteger;
  Port: TInteger;
  Index: TInteger;
begin
  Device := R[ReadNext];
  Port := R[ReadNext];
  Index := ReadNext;
  if StatusRegister.UserMode then begin
    Interrupt(siUserOut);
  end else begin
    if Assigned(FOnOutput) then FOnOutput(Device, Port, R[Index]);
  end;
end;

procedure TCpu.InstructionJump;
begin
  InstructionPointer := ReadNext;
end;

procedure TCpu.InstructionJumpRel;
begin
  InstructionPointer := InstructionPointer + ReadNext;
end;

procedure TCpu.InstructionJumpZero;
var
  Index: TInteger;
  Address: TInteger;
begin
  Index := ReadNext;
  Address := ReadNext;
  if R[Index] = 0 then InstructionPointer := Address;
end;

procedure TCpu.InstructionJumpNotZero;
var
  Index: TInteger;
  Address: TInteger;
begin
  Index := ReadNext;
  Address := ReadNext;
  if R[Index] <> 0 then InstructionPointer := Address;
end;

procedure TCpu.InstructionPush;
begin
  Push(R[ReadNext]);
end;

procedure TCpu.InstructionPop;
begin
  R[ReadNext] := Pop;
end;

procedure TCpu.InstructionCall;
var
  Address: TInteger;
begin
  Address := ReadNext;
  Push(InstructionPointer);
  InstructionPointer := Address;
end;

procedure TCpu.InstructionRet;
begin
  InstructionPointer := Pop;
end;

procedure TCpu.InstructionReti;
begin
  if StatusRegister.UserMode then begin
    Interrupt(siPrivilegedInstruction);
    Exit;
  end;
  if StatusRegister.UserModeWasActive then ActivateUserMode;
  StatusRegister.InterruptEnabled := True;
  InstructionPointer := Pop;
end;

procedure TCpu.InstructionAnd;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] and R[ReadNext];
end;

procedure TCpu.InstructionOr;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] or R[ReadNext];
end;

procedure TCpu.InstructionXor;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] xor R[ReadNext];
end;

procedure TCpu.InstructionShl;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] shl R[ReadNext];
end;

procedure TCpu.InstructionShr;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] shr R[ReadNext];
end;

procedure TCpu.InstructionMod;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] mod R[ReadNext];
end;

procedure TCpu.InstructionDiv;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] div R[ReadNext];
end;

procedure TCpu.InstructionMul;
var
  Index: TInteger;
begin
  Index := ReadNext;
  R[Index] := R[Index] * R[ReadNext];
end;

procedure TCpu.InstructionLoadIndex;
begin
  R[ReadNext] := FMemory.Base[R[ReadNext] + ReadNext];
end;

procedure TCpu.InstructionStoreIndex;
begin
  FMemory.Base[R[ReadNext] + ReadNext] := R[ReadNext];
end;

procedure TCpu.InstructionLoadCpu;
var
  Index: TInteger;
  I: TInteger;
begin
  R[ReadNext] := FMemory.Base[R[ReadNext]];
  Index := ReadNext;
  I := ReadNext;
  case TCpuRegister(I) of
    crIP: R[Index] := InstructionPointer;
    crSP: R[Index] := StackPointer;
    crStatusRegister: R[Index] := StatusRegister.GetInteger;
    crUserMemoryBase: R[Index] := Pointer(FUserMemory.Base) - Pointer(FBaseMemory.Base);
    crUserMemorySize: R[Index] := FUserMemory.Size;
  end;
end;

procedure TCpu.InstructionStoreCpu;
var
  Index: TInteger;
  I: TInteger;
begin
  if StatusRegister.UserMode then begin
    Interrupt(siPrivilegedInstruction);
    Exit;
  end;
  R[ReadNext] := FMemory.Base[R[ReadNext]];
  Index := ReadNext;
  I := ReadNext;
  case TCpuRegister(I) of
    crIP: InstructionPointer := R[Index];
    crSP: StackPointer := R[Index];
    crStatusRegister: StatusRegister.SetInteger(R[Index]);
    crUserMemoryBase: FUserMemory.Base := Pointer(FBaseMemory.Base) + R[Index];
    crUserMemorySize: FUserMemory.Size := R[Index];
  end;
end;

procedure TCpu.InstructionEi;
begin
  if StatusRegister.UserMode then begin
    Interrupt(siPrivilegedInstruction);
    Exit;
  end;
  StatusRegister.InterruptEnabled := True;
end;

procedure TCpu.InstructionDi;
begin
  if StatusRegister.UserMode then begin
    Interrupt(siPrivilegedInstruction);
    Exit;
  end;
  StatusRegister.InterruptEnabled := False;
end;

procedure TCpu.SetMemory(AValue: TIntegerArray);
begin
  if (FBaseMemory.Base = AValue) and (FBaseMemory.Size = Length(AValue)) then Exit;
  FBaseMemory.Base := AValue;
  FBaseMemory.Size := Length(AValue);
end;

procedure TCpu.CheckInterreupts;
begin
  if StatusRegister.InterruptEnabled and (FNextInterupt <> -1) then begin
    Push(InstructionPointer);
    if StatusRegister.UserMode then DeactivateUserMode;
    InstructionPointer := FMemory.Base[FNextInterupt];
    StatusRegister.InterruptEnabled := False;
    FNextInterupt := -1;
    FHalted := False;
  end;
end;

procedure TCpu.Push(Value: TInteger);
begin
  Dec(StackPointer);
  FMemory.Base[StackPointer] := Value;
end;

function TCpu.Pop: TInteger;
begin
  Result := FMemory.Base[StackPointer];
  Inc(StackPointer);
end;

procedure TCpu.StoreContext;
var
  I: Integer;
begin
  for I := 0 to Length(R) - 1 do
    Push(R[I]);
end;

procedure TCpu.LoadContext;
var
  I: Integer;
begin
  for I := Length(R) - 1 downto 0 do
    R[I] := Pop;
end;

procedure TCpu.InitInstructions;
begin
  FInstructionHandlers[inNop] := InstructionNop;
  FInstructionHandlers[inHalt] := InstructionHalt;
  FInstructionHandlers[inSet] := InstructionSet;
  FInstructionHandlers[inCopy] := InstructionCopy;
  FInstructionHandlers[inLoad] := InstructionLoad;
  FInstructionHandlers[inStore] := InstructionStore;
  FInstructionHandlers[inInc] := InstructionInc;
  FInstructionHandlers[inDec] := InstructionDec;
  FInstructionHandlers[inAdd] := InstructionAdd;
  FInstructionHandlers[inSub] := InstructionSub;
  FInstructionHandlers[inIn] := InstructionIn;
  FInstructionHandlers[inOut] := InstructionOut;
  FInstructionHandlers[inJump] := InstructionJump;
  FInstructionHandlers[inJumpRel] := InstructionJumpRel;
  FInstructionHandlers[inJumpZero] := InstructionJumpZero;
  FInstructionHandlers[inJumpNotZero] := InstructionJumpNotZero;
  FInstructionHandlers[inPush] := InstructionPush;
  FInstructionHandlers[inPop] := InstructionPop;
  FInstructionHandlers[inCall] := InstructionCall;
  FInstructionHandlers[inRet] := InstructionRet;
  FInstructionHandlers[inAnd] := InstructionAnd;
  FInstructionHandlers[inOr] := InstructionOr;
  FInstructionHandlers[inXor] := InstructionXor;
  FInstructionHandlers[inShl] := InstructionShl;
  FInstructionHandlers[inShr] := InstructionShr;
  FInstructionHandlers[inMul] := InstructionMul;
  FInstructionHandlers[inDiv] := InstructionDiv;
  FInstructionHandlers[inMod] := InstructionMod;
  FInstructionHandlers[inLoadIndex] := InstructionLoadIndex;
  FInstructionHandlers[inStoreIndex] := InstructionStoreIndex;
  FInstructionHandlers[inLoadCpu] := InstructionLoadCpu;
  FInstructionHandlers[inStoreCpu] := InstructionStoreCpu;
  FInstructionHandlers[inEi] := InstructionEi;
  FInstructionHandlers[inDi] := InstructionDi;
end;

procedure TCpu.ActivateUserMode;
begin
  StatusRegister.UserMode := True;
  FMemory := FUserMemory;
end;

procedure TCpu.DeactivateUserMode;
begin
  FMemory := FBaseMemory;
  StatusRegister.UserModeWasActive := StatusRegister.UserMode;
  StatusRegister.UserMode := False;
end;

function TCpu.ReadNext: TInteger;
begin
  if InstructionPointer >= FMemory.Size then InstructionPointer := 0;
  Result := FMemory.Base[InstructionPointer];
  Inc(InstructionPointer);
end;

procedure TCpu.WriteNext(Value: TInteger);
begin
  if InstructionPointer >= FMemory.Size then InstructionPointer := 0;
  FMemory.Base[InstructionPointer] := Value;
  Inc(InstructionPointer);
end;

procedure TCpu.Step;
var
  Instruction: TInstruction;
begin
  Instruction := TInstruction(ReadNext);
  if Assigned(FInstructionHandlers[Instruction]) then
    FInstructionHandlers[Instruction]
    else raise Exception.Create('Missing handler for instruction ' + IntToStr(Integer(Instruction)));
  Inc(FTicks);
end;

procedure TCpu.Start;
begin
  if not Running then begin
    Reset;
    FThread := TCpuThread.Create(True);
    FThread.Cpu := Self;
    FThread.Start;
    FRunning := True;
  end;
end;

procedure TCpu.Stop;
begin
  if Running then begin
    FHalted := True;
    FThread.Terminate;
    FThread.WaitFor;
    FreeAndNil(FThread);
    FRunning := False;
  end;
end;

procedure TCpu.Reset;
var
  I: Integer;
begin
  FMemory := FBaseMemory;
  FNextInterupt := -1;
  FHalted := False;
  FTicks := 0;
  InstructionPointer := FMemory.Base[Integer(siReset)];
  StackPointer := FMemory.Size;
  for I := 0 to Length(R) - 1 do
    R[I] := 0;
end;

procedure TCpu.Interrupt(Index: TSystemInterrupt);
begin
  Interrupt(TInteger(Index));
end;

procedure TCpu.Interrupt(Index: TInteger);
begin
  FNextInterupt := Index;
end;

constructor TCpu.Create;
begin
  SetLength(R, 16);
  Memory := nil;
  InitInstructions;
end;

destructor TCpu.Destroy;
begin
  Stop;
  inherited;
end;

end.