source: branches/bigint/Cpu.pas

unit Cpu;

interface

uses
  Classes, SysUtils, Int;

type
  TInstructionEvent = procedure of object;

  TInstruction = (inNop, inHalt, inLoad, inLoadConst, inInput, inOutput,
    inJump, inJumpZero, inJumpNotZero, inInc, inDec, inLoadIndex, inPush, inPop,
    inCall, inRet, inLoadMem, inStoreMem);

  { TCpu }

  TCpu = class
  private
    FOnReadIo: TReadAddrEvent;
    FOnReadMem: TReadAddrEvent;
    FOnWriteIo: TWriteAddrEvent;
    FOnWriteMem: TWriteAddrEvent;
    Instructions: array[TInstruction] of TInstructionEvent;
    procedure InstructionNop;
    procedure InstructionHalt;
    procedure InstructionLoad;
    procedure InstructionLoadConst;
    procedure InstructionLoadIndex;
    procedure InstructionLoadMem;
    procedure InstructionStoreMem;
    procedure InstructionInput;
    procedure InstructionOutput;
    procedure InstructionInc;
    procedure InstructionDec;
    procedure InstructionJump;
    procedure InstructionJumpZero;
    procedure InstructionJumpNotZero;
    procedure InstructionPush;
    procedure InstructionPop;
    procedure InstructionCall;
    procedure InstructionRet;
    procedure WriteMem(Address, Data: TInt);
    function ReadMem(Address: TInt): TInt;
    function ReadMemPc: TInt;
    procedure WriteIo(Address, Data: TInt);
    function ReadIo(Address: TInt): TInt;
    procedure Push(Data: TInt);
    function Pop: TInt;
  public
    Halted: Boolean;
    PC: TInt;
    SP: TInt;
    procedure Reset;
    procedure Run;
    procedure Step;
    constructor Create;
    property OnReadMem: TReadAddrEvent read FOnReadMem write FOnReadMem;
    property OnWriteMem: TWriteAddrEvent read FOnWriteMem write FOnWriteMem;
    property OnReadIo: TReadAddrEvent read FOnReadIo write FOnReadIo;
    property OnWriteIo: TWriteAddrEvent read FOnWriteIo write FOnWriteIo;
  end;

implementation

{ TCpu }

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

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

procedure TCpu.InstructionLoad;
var
  Dst, Src: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  WriteMem(Dst, ReadMem(Src));
end;

procedure TCpu.InstructionLoadConst;
var
  Dst, Data: TInt;
begin
  Dst := ReadMemPc;
  Data := ReadMemPc;
  WriteMem(Dst, Data);
end;

procedure TCpu.InstructionLoadIndex;
var
  Dst, Src, Index: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  Index := ReadMemPc;
  WriteMem(Dst, ReadMem(Src + Index));
end;

procedure TCpu.InstructionLoadMem;
var
  Dst, Src: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  WriteMem(Dst, ReadMem(ReadMem(Src)));
end;

procedure TCpu.InstructionStoreMem;
var
  Dst, Src: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  WriteMem(ReadMem(Dst), ReadMem(Src));
end;

procedure TCpu.InstructionInput;
var
  Dst, Src: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  WriteMem(Dst, ReadIo(Src));
end;

procedure TCpu.InstructionOutput;
var
  Dst, Src: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  WriteIo(Dst, ReadMem(Src));
end;

procedure TCpu.InstructionInc;
var
  Addr: TInt;
begin
  Addr := ReadMemPc;
  WriteMem(Addr, ReadMem(Addr) + 1);
end;

procedure TCpu.InstructionDec;
var
  Addr: TInt;
begin
  Addr := ReadMemPc;
  WriteMem(Addr, ReadMem(Addr) - 1);
end;

procedure TCpu.InstructionJump;
begin
  PC := ReadMemPc;
end;

procedure TCpu.InstructionJumpZero;
var
  Condition: TInt;
  Addr: TInt;
begin
  Condition := ReadMemPc;
  Addr := ReadMemPc;
  if ReadMem(Condition) = 0 then PC := Addr;
end;

procedure TCpu.InstructionJumpNotZero;
var
  Condition: TInt;
  Addr: TInt;
begin
  Condition := ReadMemPc;
  Addr := ReadMemPc;
  if ReadMem(Condition) <> 0 then PC := Addr;
end;

procedure TCpu.InstructionPush;
begin
  Push(ReadMem(ReadMemPc));
end;

procedure TCpu.InstructionPop;
begin
  WriteMem(ReadMemPc, Pop);
end;

procedure TCpu.InstructionCall;
var
  Addr: TInt;
begin
  Addr := ReadMemPc;
  Push(PC);
  PC := Addr;
end;

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

procedure TCpu.WriteMem(Address, Data: TInt);
begin
  if Assigned(FOnWriteMem) then FOnWriteMem(Address, Data);
end;

function TCpu.ReadMem(Address: TInt): TInt;
begin
  if Assigned(FOnReadMem) then Result := FOnReadMem(Address)
    else Result := 0;
end;

function TCpu.ReadMemPc: TInt;
begin
  Result := ReadMem(PC);
  Inc(PC);
end;

procedure TCpu.WriteIo(Address, Data: TInt);
begin
  if Assigned(FOnWriteIo) then FOnWriteIo(Address, Data);
end;

function TCpu.ReadIo(Address: TInt): TInt;
begin
  if Assigned(FOnReadIo) then Result := FOnReadIo(Address)
    else Result := 0;
end;

procedure TCpu.Push(Data: TInt);
begin
  Dec(SP);
  WriteMem(SP, Data);
end;

function TCpu.Pop: TInt;
begin
  Result := ReadMem(SP);
  Inc(SP);
end;

procedure TCpu.Reset;
begin
  PC := 0;
  SP := 1000;
  Halted := False;
end;

procedure TCpu.Run;
begin
  Reset;
  while not Halted do
    Step;
end;

procedure TCpu.Step;
var
  Opcode: TInstruction;
begin
  Opcode := TInstruction(FOnReadMem(PC));
  Inc(PC);
  Instructions[Opcode];
end;

constructor TCpu.Create;
begin
  Instructions[inNop] := InstructionNop;
  Instructions[inHalt] := InstructionHalt;
  Instructions[inLoad] := InstructionLoad;
  Instructions[inLoadIndex] := InstructionLoadIndex;
  Instructions[inLoadConst] := InstructionLoadConst;
  Instructions[inLoadMem] := InstructionLoadMem;
  Instructions[inStoreMem] := InstructionStoreMem;
  Instructions[inInput] := InstructionInput;
  Instructions[inOutput] := InstructionOutput;
  Instructions[inJump] := InstructionJump;
  Instructions[inJumpZero] := InstructionJumpZero;
  Instructions[inJumpNotZero] := InstructionJumpNotZero;
  Instructions[inInc] := InstructionInc;
  Instructions[inDec] := InstructionDec;
  Instructions[inPush] := InstructionPush;
  Instructions[inPop] := InstructionPop;
  Instructions[inCall] := InstructionCall;
  Instructions[inRet] := InstructionRet;
end;

end.