source: branches/test3/Cpu.pas

unit Cpu;

interface

uses
  Classes, SysUtils;

type
  TInstruction = (inNop, inHalt,
    inConstD, inConstA, inConstN,
    inLoadD, inLoadA, inLoadN,
    inStoreD, inStoreA, inStoreN,
    inInputD, inInputA, inInputN,
    inOutputD, inOutputA, inOutputN,
    inAdd, inSub);

  { TCpu }

  TCpu<TData,TAddr,TMax> = class
  type
    PData = ^TData;
    PAddr = ^TAddr;
    PMax = ^TMax;
    TRegIndex = 0..255;
    TOnInput = function (Addr: TAddr; Count: Byte): TData of object;
    TOnOutput = procedure (Addr: TAddr; Data: TData; Count: Byte) of object;
  private
    FOnInput: TOnInput;
    FOnOutput: TOnOutput;
  public
    Memory: array[0..$ffff] of Byte;
    PC: TAddr;
    SP: TAddr;
    R: array[TRegIndex] of TMax;
    Terminated: Boolean;
    procedure Run;
    procedure Step;
    procedure Reset;
    procedure AddConstD(Reg: TRegIndex; Value: TData);
    procedure AddConstA(Reg: TRegIndex; Value: TAddr);
    procedure AddConstN(Count: Byte; Reg: TRegIndex; Value: TMax);
    procedure AddOutputD(Addr: TAddr; Reg: TRegIndex);
    procedure AddOutputA(Addr: TAddr; Reg: TRegIndex);
    procedure AddOutputN(Count: Byte; Addr: TAddr; Reg: TRegIndex);
    procedure AddHalt;
    function ReadBytePC: Byte;
    function ReadDataPC: TData;
    function ReadAddrPC: TAddr;
    function ReadPC(Count: Byte): TMax;
    function ReadData(Addr: TAddr): TData;
    function ReadAddr(Addr: TAddr): TAddr;
    function Read(Addr: TAddr; Count: Byte): TMax;
    function ReadRegData(Reg: TRegIndex): TData;
    function ReadRegAddr(Reg: TRegIndex): TAddr;
    function ReadReg(Reg: TRegIndex; Count: Byte): TMax;
    procedure WriteBytePC(Data: Byte);
    procedure WriteRegPC(Reg: TRegIndex);
    procedure WriteDataPC(Data: TData);
    procedure WriteAddrPC(Addr: TAddr);
    procedure WritePC(Value: TMax; Count: Byte);
    procedure WriteData(Addr: TAddr; Value: TData);
    procedure WriteAddr(Addr, Value: TAddr);
    procedure WriteRegData(Reg: TRegIndex; Value: TData);
    procedure WriteRegAddr(Reg: TRegIndex; Value: TAddr);
    procedure WriteReg(Reg: TRegIndex; Value: TMax; Count: Byte);
    constructor Create;
    destructor Destroy; override;
    property OnInput: TOnInput read FOnInput write FOnInput;
    property OnOutput: TOnOutput read FOnOutput write FOnOutput;
  end;


implementation

{ TCpu }

procedure TCpu<TData,TAddr,TMax>.Run;
begin
  Reset;
  while not Terminated do
    Step;
end;

procedure TCpu<TData,TAddr,TMax>.Step;
var
  Instruction: TInstruction;
  I: TRegIndex;
  Addr: TAddr;
  N: Byte;
  M: TMax;
begin
  Instruction := TInstruction(ReadBytePC);
  case Instruction of
    inNop: ;
    inHalt: Terminated := True;
    inConstD: PData(@R[ReadBytePC])^ := ReadDataPC;
    inConstA: PAddr(@R[ReadBytePC])^ := ReadAddrPC;
    inConstN: begin
      N := ReadBytePC;
      I := ReadBytePC;
      WriteReg(I, ReadPC(N), N);
    end;
    inLoadD: PData(@R[ReadBytePC])^ := ReadData(ReadAddrPC);
    inLoadA: PAddr(@R[ReadBytePC])^ := ReadAddr(ReadAddrPC);
    inLoadN: begin
      N := ReadBytePC;
      WriteReg(ReadBytePC, Read(ReadAddrPC, N), N);
    end;
    inStoreD: WriteData(ReadAddrPC, R[ReadBytePC]);
    inStoreA: WriteAddr(ReadAddrPC, R[ReadBytePC]);
    inStoreN: begin
      N := ReadBytePC;
      Write(ReadAddrPC, ReadReg(ReadBytePC, N), N);
    end;
    inInputD: begin
      I := ReadBytePC;
      Addr := ReadAddrPC;
      if Assigned(FOnInput) then PData(@R[I])^ := FOnInput(Addr, SizeOf(TData))
        else R[I] := 0;
    end;
    inInputA: begin
      I := ReadBytePC;
      Addr := ReadAddrPC;
      if Assigned(FOnInput) then PAddr(@R[I])^ := FOnInput(Addr, SizeOf(TAddr))
        else R[I] := 0;
    end;
    inInputN: begin
      N := ReadBytePC;
      I := ReadBytePC;
      Addr := ReadAddrPC;
      if Assigned(FOnInput) then begin
        M := FOnInput(Addr, N);
        Move(M, R[I], N);
      end else R[I] := 0;
    end;
    inOutputD: begin
      Addr := ReadAddrPC;
      I := ReadBytePC;
      if Assigned(FOnOutput) then FOnOutput(Addr, PData(@R[I])^, SizeOf(TData));
    end;
    inOutputA: begin
      Addr := ReadAddrPC;
      I := ReadBytePC;
      if Assigned(FOnOutput) then FOnOutput(Addr, PAddr(@R[I])^, SizeOf(TAddr));
    end;
    inOutputN: begin
      N := ReadBytePC;
      Addr := ReadAddrPC;
      I := ReadBytePC;
      M := 0;
      Move(R[I], M, N);
      if Assigned(FOnOutput) then FOnOutput(Addr, M, N);
    end;
  end;
end;

procedure TCpu<TData,TAddr,TMax>.Reset;
begin
  SP := 0;
  PC := 0;
  Terminated := False;
end;

procedure TCpu<TData,TAddr,TMax>.AddConstD(Reg: TRegIndex; Value: TData);
begin
  WriteBytePC(Byte(inConstD));
  WriteRegPC(Reg);
  WriteDataPC(Value);
end;

procedure TCpu<TData, TAddr, TMax>.AddConstA(Reg: TRegIndex; Value: TAddr);
begin
  WriteBytePC(Byte(inConstA));
  WriteRegPC(Reg);
  WriteAddrPC(Value);
end;

procedure TCpu<TData, TAddr, TMax>.AddConstN(Count: Byte; Reg: TRegIndex;
  Value: TMax);
begin
  WriteBytePC(Byte(inConstN));
  WriteBytePc(Count);
  WriteRegPC(Reg);
  WritePC(Value, Count);
end;

procedure TCpu<TData, TAddr, TMax>.AddOutputD(Addr: TAddr; Reg: TRegIndex);
begin
  WriteBytePC(Byte(inOutputD));
  WriteAddrPC(Addr);
  WriteRegPC(Reg);
end;

procedure TCpu<TData, TAddr, TMax>.AddOutputA(Addr: TAddr; Reg: TRegIndex);
begin
  WriteBytePC(Byte(inOutputA));
  WriteAddrPC(Addr);
  WriteRegPC(Reg);
end;

procedure TCpu<TData, TAddr, TMax>.AddOutputN(Count: Byte; Addr: TAddr;
  Reg: TRegIndex);
begin
  WriteBytePC(Byte(inOutputN));
  WriteBytePC(Count);
  WriteAddrPC(Addr);
  WriteRegPC(Reg);
end;

procedure TCpu<TData,TAddr,TMax>.AddHalt;
begin
  WriteBytePC(Byte(inHalt));
end;

function TCpu<TData,TAddr,TMax>.ReadBytePC: Byte;
begin
  Result := Memory[PC];
  Inc(PC);
end;

function TCpu<TData,TAddr,TMax>.ReadDataPC: TData;
begin
  Result := PData(@Memory[PC])^;
  Inc(PC, SizeOf(TData));
end;

function TCpu<TData,TAddr,TMax>.ReadAddrPC: TAddr;
begin
  Result := PAddr(@Memory[PC])^;
  Inc(PC, SizeOf(TAddr));
end;

function TCpu<TData, TAddr, TMax>.ReadPC(Count: Byte): TMax;
begin
  Move(PMax(@Memory[PC])^, Result, Count);
  Inc(PC, SizeOf(Count));
end;

function TCpu<TData,TAddr,TMax>.ReadData(Addr: TAddr): TData;
begin
  Result := PData(@Memory[Addr])^;
end;

function TCpu<TData, TAddr, TMax>.ReadAddr(Addr: TAddr): TAddr;
begin
  Result := PAddr(@Memory[Addr])^;
end;

function TCpu<TData, TAddr, TMax>.Read(Addr: TAddr; Count: Byte): TMax;
begin
  Move(PMax(@Memory[Addr])^, Result, Count);
end;

function TCpu<TData, TAddr, TMax>.ReadRegData(Reg: TRegIndex): TData;
begin
  Result := PData(@R[Reg])^;
end;

function TCpu<TData, TAddr, TMax>.ReadRegAddr(Reg: TRegIndex): TAddr;
begin
  Result := PAddr(@R[Reg])^;
end;

function TCpu<TData, TAddr, TMax>.ReadReg(Reg: TRegIndex; Count: Byte): TMax;
begin
  Move(PMax(@R[Reg])^, Result, Count);
end;

procedure TCpu<TData,TAddr,TMax>.WriteBytePC(Data: Byte);
begin
  Memory[PC] := Data;
  Inc(PC);
end;

procedure TCpu<TData,TAddr,TMax>.WriteRegPC(Reg: TRegIndex);
begin
  Memory[PC] := Reg;
  Inc(PC, SizeOf(Reg));
end;

procedure TCpu<TData,TAddr,TMax>.WriteDataPC(Data: TData);
begin
  WriteData(PC, Data);
  Inc(PC, SizeOf(TData));
end;

procedure TCpu<TData,TAddr,TMax>.WriteAddrPC(Addr: TAddr);
begin
  WriteAddr(PC, Addr);
  Inc(PC, SizeOf(TAddr));
end;

procedure TCpu<TData, TAddr, TMax>.WritePC(Value: TMax; Count: Byte);
begin
  Move(Value, PMax(@Memory[PC])^, Count);
  Inc(PC, Count);
end;

procedure TCpu<TData,TAddr,TMax>.WriteData(Addr: TAddr; Value: TData);
begin
  PData(@Memory[Addr])^ := Value;
end;

procedure TCpu<TData,TAddr,TMax>.WriteAddr(Addr, Value: TAddr);
begin
  PAddr(@Memory[Addr])^ := Value;
end;

procedure TCpu<TData, TAddr, TMax>.WriteRegData(Reg: TRegIndex; Value: TData);
begin
  PData(@R[Reg])^ := Value;
end;

procedure TCpu<TData, TAddr, TMax>.WriteRegAddr(Reg: TRegIndex; Value: TAddr);
begin
  PAddr(@R[Reg])^ := Value;
end;

procedure TCpu<TData, TAddr, TMax>.WriteReg(Reg: TRegIndex; Value: TMax;
  Count: Byte);
begin
  R[Reg] := 0;
  Move(Value, PMax(@R[Reg])^, Count);
end;

constructor TCpu<TData,TAddr,TMax>.Create;
begin
end;

destructor TCpu<TData,TAddr,TMax>.Destroy;
begin
  inherited;
end;

end.