unit Cpu;

interface

uses
  Classes, SysUtils, Int;

type
  TInstructionEvent = procedure of object;

  TInstruction = (inNop, inHalt, inLoad, inLoadConst, inInput, inOutput,
    inJump, inJumpZero, inJumpNotZero, inIncrement, inDecrement, inLoadIndex,
    inPush, inPop, inCall, inReturn, inLoadMem, inStoreMem, inAdd, inSubtract,
    inAnd, inOr, inXor, inShiftLeft, inShiftRight, inJumpRel, inJumpRelZero,
    inJumpRelNotZero, inBitSet, inBitReset, inBitTest, inGetMaxInt, inGetMinInt);

  { 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 InstructionJumpRel;
    procedure InstructionJumpRelZero;
    procedure InstructionJumpRelNotZero;
    procedure InstructionPush;
    procedure InstructionPop;
    procedure InstructionCall;
    procedure InstructionRet;
    procedure InstructionAdd;
    procedure InstructionSub;
    procedure InstructionAnd;
    procedure InstructionOr;
    procedure InstructionXor;
    procedure InstructionShl;
    procedure InstructionShr;
    procedure InstructionBitSet;
    procedure InstructionBitReset;
    procedure InstructionBitTest;
    procedure InstructionGetMaxInt;
    procedure InstructionGetMinInt;
    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.InstructionJumpRel;
var
  Addr: TInt;
begin
  Addr := ReadMemPc;
  PC := PC + Addr;
end;

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

procedure TCpu.InstructionJumpRelNotZero;
var
  Condition: TInt;
  Addr: TInt;
begin
  Condition := ReadMemPc;
  Addr := ReadMemPc;
  if ReadMem(Condition) <> 0 then PC := 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.InstructionAdd;
var
  Dst, Src1, Src2: TInt;
begin
  Dst := ReadMemPc;
  Src1 := ReadMemPc;
  Src2 := ReadMemPc;
  WriteMem(Dst, ReadMem(Src1) + ReadMem(Src2));
end;

procedure TCpu.InstructionSub;
var
  Dst, Src1, Src2: TInt;
begin
  Dst := ReadMemPc;
  Src1 := ReadMemPc;
  Src2 := ReadMemPc;
  WriteMem(Dst, ReadMem(Src1) - ReadMem(Src2));
end;

procedure TCpu.InstructionAnd;
var
  Dst, Src1, Src2: TInt;
begin
  Dst := ReadMemPc;
  Src1 := ReadMemPc;
  Src2 := ReadMemPc;
  WriteMem(Dst, ReadMem(Src1) and ReadMem(Src2));
end;

procedure TCpu.InstructionOr;
var
  Dst, Src1, Src2: TInt;
begin
  Dst := ReadMemPc;
  Src1 := ReadMemPc;
  Src2 := ReadMemPc;
  WriteMem(Dst, ReadMem(Src1) or ReadMem(Src2));
end;

procedure TCpu.InstructionXor;
var
  Dst, Src1, Src2: TInt;
begin
  Dst := ReadMemPc;
  Src1 := ReadMemPc;
  Src2 := ReadMemPc;
  WriteMem(Dst, ReadMem(Src1) xor ReadMem(Src2));
end;

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

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

procedure TCpu.InstructionBitSet;
var
  Dst, Src, Bit: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  Bit := ReadMemPc;
  WriteMem(Dst, ReadMem(Src) or (1 << ReadMem(Bit)));
end;

procedure TCpu.InstructionBitReset;
var
  Dst, Src, Bit: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  Bit := ReadMemPc;
  WriteMem(Dst, ReadMem(Src) and (-1 xor (1 << ReadMem(Bit))));
end;

procedure TCpu.InstructionBitTest;
var
  Dst, Src, Bit: TInt;
begin
  Dst := ReadMemPc;
  Src := ReadMemPc;
  Bit := ReadMemPc;
  WriteMem(Dst, (ReadMem(Src) >> ReadMem(Bit)) and 1);
end;

procedure TCpu.InstructionGetMaxInt;
var
  Dst: TInt;
begin
  Dst := ReadMemPc;
  WriteMem(Dst, SizeOf(TInt) * 8);
end;

procedure TCpu.InstructionGetMinInt;
var
  Dst: TInt;
begin
  Dst := ReadMemPc;
//  WriteMem(Dst, SizeOf(TInt) * 8);
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[inJumpRel] := InstructionJumpRel;
  Instructions[inJumpRelZero] := InstructionJumpRelZero;
  Instructions[inJumpRelNotZero] := InstructionJumpRelNotZero;
  Instructions[inIncrement] := InstructionInc;
  Instructions[inDecrement] := InstructionDec;
  Instructions[inPush] := InstructionPush;
  Instructions[inPop] := InstructionPop;
  Instructions[inCall] := InstructionCall;
  Instructions[inReturn] := InstructionRet;
  Instructions[inAdd] := InstructionAdd;
  Instructions[inSubtract] := InstructionSub;
  Instructions[inAnd] := InstructionAnd;
  Instructions[inOr] := InstructionOr;
  Instructions[inXor] := InstructionXor;
  Instructions[inShiftLeft] := InstructionShl;
  Instructions[inShiftRight] := InstructionShr;
  Instructions[inBitSet] := InstructionBitSet;
  Instructions[inBitReset] := InstructionBitReset;
  Instructions[inBitTest] := InstructionBitTest;
  Instructions[inGetMaxInt] := InstructionGetMaxInt;
  Instructions[inGetMinInt] := InstructionGetMinInt;
end;

end.