source: branches/configured machine/Cpu.pas

unit Cpu;

interface

uses
  Classes, SysUtils, Memory;

type
  TBitWidth = (bw8, bw16, bw32, bw64, bw128, bw256, bw512, bw1024);

  TOpcode = (opNop, opHalt, opLoadMem, opStoreMem, opIncrement, opDecrement,
    opJump, opPush, opPop, opCall, opReturn, opInput, opOutput, opAdd,
    opSubtract, opLoad,
    opDataWidth8, opDataWidth16, opAddressWidth8, opAddressWidth16);

  { TValue }

  TValue = record
    class function Create8(Value: Byte): TValue; static;
    class function Create16(Value: Word): TValue; static;
    class function Create32(Value: DWord): TValue; static;
    class function Create64(Value: QWord): TValue; static;
    case TBitWidth of
      bw8: (Value8: Byte);
      bw16: (Value16: Word);
      bw32: (Value32: DWord);
      bw64: (Value64: QWord);
  end;

  TSignedValue = record
    case TBitWidth of
      bw8: (Value8: ShortInt);
      bw16: (Value16: SmallInt);
      bw32: (Value32: LongInt);
      bw64: (Value64: Int64);
  end;

  { TCpu }

  TCpu = class
  private
    FAddress: TValue;
    FAddressWidth: TBitWidth;
    FDataWidth: TBitWidth;
    FFrequency: Integer;
    FOnOutput: TNotifyEvent;
    FOnInput: TNotifyEvent;
    FOnRead: TNotifyEvent;
    FOnWrite: TNotifyEvent;
    function GetFrequency: Integer;
    procedure SetAddressWidth(AValue: TBitWidth);
    procedure SetFrequency(AValue: Integer);
    procedure SetDataWidth(AValue: TBitWidth);
    procedure Push(Data: TValue; BitWidth: TBitWidth);
    procedure Pop(var Data: TValue; BitWidth: TBitWidth);
    procedure DoRead;
    procedure DoWrite;
    procedure DoInput;
    procedure DoOutput;
  public
    IP: TValue;
    SP: TValue;
    A: TValue;
    Terminated: Boolean;
    Data: TValue;
    procedure Reset;
    procedure Step;
    procedure Run;
    constructor Create;
    destructor Destroy; override;
    procedure AssignValue(var Dest: TValue; Source: TValue; Width: TBitWidth);
    procedure ReadD8A8(var AAddress: TValue; var AData: TValue; Increment: Boolean);
    procedure ReadD8A16(var AAddress: TValue; var AData: TValue; Increment: Boolean);
    procedure ReadD16A8(var AAddress: TValue; var AData: TValue; Increment: Boolean);
    procedure ReadD16A16(var AAddress: TValue; var AData: TValue; Increment: Boolean);
    procedure Read(var Address: TValue; var Data: TValue; Increment: Boolean;
      AddressWidth: TBitWidth; DataWidth: TBitWidth);
    procedure ReadAddressA8(var Address: TValue; var Data: TValue; Increment: Boolean);
    procedure ReadAddressA16(var Address: TValue; var Data: TValue; Increment: Boolean);
    procedure ReadDataA8(var Address: TValue; var Data: TValue; Increment: Boolean);
    procedure ReadDataA16(var Address: TValue; var Data: TValue; Increment: Boolean);
    procedure ReadData(var Address: TValue; var Data: TValue; Increment: Boolean);
    procedure ReadAddress(var Address: TValue; var Data: TValue; Increment: Boolean);
    procedure WriteD8A8(var Address: TValue; AData: TValue; Increment: Boolean);
    procedure WriteD8A16(var Address: TValue; AData: TValue; Increment: Boolean);
    procedure WriteD16A8(var Address: TValue; AData: TValue; Increment: Boolean);
    procedure WriteD16A16(var Address: TValue; AData: TValue; Increment: Boolean);
    procedure Write(var Address: TValue; Data: TValue; Increment: Boolean;
      AddressWidth: TBitWidth; DataWidth: TBitWidth);
    procedure WriteAddressA8(var Address: TValue; Data: TValue; Increment: Boolean);
    procedure WriteAddressA16(var Address: TValue; Data: TValue; Increment: Boolean);
    procedure WriteDataA8(var Address: TValue; Data: TValue; Increment: Boolean);
    procedure WriteDataA16(var Address: TValue; Data: TValue; Increment: Boolean);
    procedure WriteData(var Address: TValue; Value: TValue; Increment: Boolean);
    procedure WriteAddress(var Address: TValue; Value: TValue; Increment: Boolean);
    property Frequency: Integer read FFrequency write FFrequency;
    property DataWidth: TBitWidth read FDataWidth write SetDataWidth;
    property Address: TValue read FAddress;
    property AddressWidth: TBitWidth read FAddressWidth write SetAddressWidth;
    property OnInput: TNotifyEvent read FOnInput write FOnInput;
    property OnOutput: TNotifyEvent read FOnOutput write FOnOutput;
    property OnRead: TNotifyEvent read FOnRead write FOnRead;
    property OnWrite: TNotifyEvent read FOnWrite write FOnWrite;
  end;

const
  BitWidthByteSize: array[TBitWidth] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);


implementation

{ TValue }

class function TValue.Create8(Value: Byte): TValue;
begin
  Result.Value8 := Value;
end;

class function TValue.Create16(Value: Word): TValue;
begin
  Result.Value16 := Value;
end;

class function TValue.Create32(Value: DWord): TValue;
begin
  Result.Value32 := Value;
end;

class function TValue.Create64(Value: QWord): TValue;
begin
  Result.Value64 := Value;
end;

procedure TCpu.ReadD8A8(var AAddress: TValue; var AData: TValue;
  Increment: Boolean);
begin
  FAddress.Value8 := AAddress.Value8;
  DoRead;
  AData.Value8 := Data.Value8;
  if Increment then AAddress.Value8 := AAddress.Value8 + 1;
end;

procedure TCpu.ReadD8A16(var AAddress: TValue; var AData: TValue;
  Increment: Boolean);
begin
  FAddress.Value16 := AAddress.Value16;
  DoRead;
  AData.Value8 := Data.Value8;
  if Increment then AAddress.Value16 := AAddress.Value16 + 1;
end;

procedure TCpu.ReadD16A8(var AAddress: TValue; var AData: TValue;
  Increment: Boolean);
begin
  FAddress.Value8 := AAddress.Value8;
  DoRead;
  AData.Value16 := Data.Value16;
  if Increment then AAddress.Value8 := AAddress.Value8 + 1;
end;

procedure TCpu.ReadD16A16(var AAddress: TValue; var AData: TValue;
  Increment: Boolean);
begin
  FAddress.Value16 := AAddress.Value16;
  DoRead;
  AData.Value16 := Data.Value16;
  if Increment then AAddress.Value16 := AAddress.Value16 + 1;
end;

procedure TCpu.Read(var Address: TValue; var Data: TValue; Increment: Boolean;
  AddressWidth: TBitWidth; DataWidth: TBitWidth);
begin
  case AddressWidth of
    bw8: case DataWidth of
      bw8: ReadD8A8(Address, Data, Increment);
      bw16: ReadD16A8(Address, Data, Increment);
    end;
    bw16: case DataWidth of
      bw8: ReadD8A16(Address, Data, Increment);
      bw16: ReadD16A16(Address, Data, Increment);
    end;
  end;
end;

procedure TCpu.ReadAddressA8(var Address: TValue; var Data: TValue;
  Increment: Boolean);
begin
  case AddressWidth of
    bw8: ReadD8A8(Address, Data, Increment);
    bw16: ReadD16A8(Address, Data, Increment);
  end;
end;

procedure TCpu.ReadAddressA16(var Address: TValue; var Data: TValue;
  Increment: Boolean);
begin
  case AddressWidth of
    bw8: ReadD8A16(Address, Data, Increment);
    bw16: ReadD16A16(Address, Data, Increment);
  end;
end;

procedure TCpu.ReadDataA8(var Address: TValue; var Data: TValue;
  Increment: Boolean);
begin
  case DataWidth of
    bw8: ReadD8A8(Address, Data, Increment);
    bw16: ReadD16A8(Address, Data, Increment);
  end;
end;

procedure TCpu.ReadDataA16(var Address: TValue; var Data: TValue;
  Increment: Boolean);
begin
  case DataWidth of
    bw8: ReadD8A16(Address, Data, Increment);
    bw16: ReadD16A16(Address, Data, Increment);
  end;
end;

procedure TCpu.ReadAddress(var Address: TValue; var Data: TValue;
  Increment: Boolean);
begin
  case AddressWidth of
    bw8: ReadAddressA8(Address, Data, Increment);
    bw16: ReadAddressA16(Address, Data, Increment);
  end;
end;

procedure TCpu.ReadData(var Address: TValue; var Data: TValue;
  Increment: Boolean);
begin
  case AddressWidth of
    bw8: ReadDataA8(Address, Data, Increment);
    bw16: ReadDataA16(Address, Data, Increment);
  end;
end;

procedure TCpu.WriteD8A8(var Address: TValue; AData: TValue; Increment: Boolean);
begin
  FAddress.Value8 := Address.Value8;
  Data.Value8 := AData.Value8;
  DoWrite;
  if Increment then Address.Value8 := Address.Value8 + 1;
end;

procedure TCpu.WriteD8A16(var Address: TValue; AData: TValue; Increment: Boolean
  );
begin
  FAddress.Value16 := Address.Value16;
  Data.Value8 := AData.Value8;
  DoWrite;
  if Increment then Address.Value16 := Address.Value16 + 1;
end;

procedure TCpu.WriteD16A8(var Address: TValue; AData: TValue; Increment: Boolean
  );
begin
  FAddress.Value8 := Address.Value8;
  Data.Value16 := AData.Value16;
  DoWrite;
  if Increment then Address.Value8 := Address.Value8 + 1;
end;

procedure TCpu.WriteD16A16(var Address: TValue; AData: TValue; Increment: Boolean
  );
begin
  FAddress.Value16 := Address.Value16;
  AData.Value16 := AData.Value16;
  DoWrite;
  if Increment then Address.Value16 := Address.Value16 + 1;
end;

procedure TCpu.Write(var Address: TValue; Data: TValue; Increment: Boolean;
  AddressWidth: TBitWidth; DataWidth: TBitWidth);
begin
  case AddressWidth of
    bw8: case DataWidth of
      bw8: WriteD8A8(Address, Data, Increment);
      bw16: WriteD16A8(Address, Data, Increment);
    end;
    bw16: case DataWidth of
      bw8: WriteD8A16(Address, Data, Increment);
      bw16: WriteD16A16(Address, Data, Increment);
    end;
  end;
end;

procedure TCpu.WriteAddressA8(var Address: TValue; Data: TValue;
  Increment: Boolean);
begin
  case AddressWidth of
    bw8: WriteD8A8(Address, Data, Increment);
    bw16: WriteD16A8(Address, Data, Increment);
  end;
end;

procedure TCpu.WriteAddressA16(var Address: TValue; Data: TValue;
  Increment: Boolean);
begin
  case AddressWidth of
    bw8: WriteD8A16(Address, Data, Increment);
    bw16: WriteD16A16(Address, Data, Increment);
  end;
end;

procedure TCpu.WriteDataA8(var Address: TValue; Data: TValue; Increment: Boolean
  );
begin
  case DataWidth of
    bw8: WriteD8A8(Address, Data, Increment);
    bw16: WriteD16A8(Address, Data, Increment);
  end;
end;

procedure TCpu.WriteDataA16(var Address: TValue; Data: TValue;
  Increment: Boolean);
begin
  case DataWidth of
    bw8: WriteD8A16(Address, Data, Increment);
    bw16: WriteD16A16(Address, Data, Increment);
  end;
end;

procedure TCpu.WriteData(var Address: TValue; Value: TValue; Increment: Boolean
  );
begin
  case AddressWidth of
    bw8: WriteDataA8(Address, Value, Increment);
    bw16: WriteDataA16(Address, Value, Increment);
  end;
end;

procedure TCpu.WriteAddress(var Address: TValue; Value: TValue;
  Increment: Boolean);
begin
  case AddressWidth of
    bw8: WriteAddressA8(Address, Value, Increment);
    bw16: WriteAddressA16(Address, Value, Increment);
  end;
end;

procedure TCpu.Push(Data: TValue; BitWidth: TBitWidth);
begin
  case AddressWidth of
    bw8: SP.Value8 := SP.Value8 - BitWidthByteSize[BitWidth];
    bw16: SP.Value16 := SP.Value16 - BitWidthByteSize[BitWidth];
  end;
  WriteData(SP, Data, False);
end;

procedure TCpu.Pop(var Data: TValue; BitWidth: TBitWidth);
begin
  ReadData(SP, Data, False);
  case AddressWidth of
    bw8: SP.Value8 := SP.Value8 + BitWidthByteSize[BitWidth];
    bw16: SP.Value16 := SP.Value16 + BitWidthByteSize[BitWidth];
  end;
end;

procedure TCpu.DoRead;
begin
  if Assigned(FOnRead) then FOnRead(Self);
end;

procedure TCpu.DoWrite;
begin
  if Assigned(FOnWrite) then FOnWrite(Self);
end;

procedure TCpu.DoInput;
begin
  if Assigned(FOnInput) then FOnInput(Self);
end;

procedure TCpu.DoOutput;
begin
  if Assigned(FOnOutput) then FOnOutput(Self);
end;

procedure TCpu.Reset;
begin
  Terminated := False;
  A.Value64 := 0;
  IP.Value64 := 0;
  SP.Value64 := 0;
end;

function TCpu.GetFrequency: Integer;
begin
  Result := FFrequency;
end;

procedure TCpu.SetAddressWidth(AValue: TBitWidth);
begin
  if FAddressWidth = AValue then Exit;
  FAddressWidth := AValue;
end;

procedure TCpu.SetFrequency(AValue: Integer);
begin
  FFrequency := AValue;
end;

procedure TCpu.SetDataWidth(AValue: TBitWidth);
begin
  if FDataWidth = AValue then Exit;
  FDataWidth := AValue;
end;

procedure TCpu.Step;
var
  Opcode: TOpcode;
  Data: TValue;
  Addr: TValue;
  LastWidth: TBitWidth;
begin
  Read(IP, Data, True, AddressWidth, bw8);
  Opcode := TOpcode(Data.Value8);
  case Opcode of
    opNop: ; // Do nothing
    opHalt: Terminated := True;
    opLoad: ReadData(IP, A, True);
    opLoadMem: begin
      ReadAddress(IP, Addr, True);
      ReadData(Addr, A, False);
    end;
    opStoreMem: begin
      ReadAddress(IP, Addr, True);
      WriteData(Addr, A, False);
    end;
    opIncrement: case DataWidth of
      bw8: A.Value8 := A.Value8 + 1;
      bw16: A.Value16 := A.Value16 + 1;
    end;
    opDecrement: case DataWidth of
      bw8: A.Value8 := A.Value8 - 1;
      bw16: A.Value16 := A.Value16 - 1;
    end;
    opJump: begin
      ReadAddress(IP, Addr, True);
      IP := Addr;
    end;
    opPush: Push(A, DataWidth);
    opPop: Pop(A, DataWidth);
    opCall: begin
      ReadAddress(IP, Addr, True);
      Push(Addr, AddressWidth);
      IP := Addr;
    end;
    opReturn: begin
      Pop(Addr, AddressWidth);
      IP := Addr;
    end;
    opAdd: begin
      ReadData(IP, Data, True);
      case DataWidth of
        bw8: A.Value8 := A.Value8 + Data.Value8;
        bw16: A.Value16 := A.Value16 + Data.Value16;
      end;
    end;
    opSubtract: begin
      ReadData(IP, Data, True);
      case DataWidth of
        bw8: A.Value8 := A.Value8 - Data.Value8;
        bw16: A.Value16 := A.Value16 - Data.Value16;
      end;
    end;
    opInput: begin
      ReadAddress(IP, FAddress, True);
      DoInput;
      AssignValue(A, Data, DataWidth);
    end;
    opOutput: begin
      ReadAddress(IP, FAddress, True);
      AssignValue(Data, A, DataWidth);
      DoOutput;
    end;
    opDataWidth8: if DataWidth <> bw8 then begin
      LastWidth := DataWidth;
      DataWidth := bw8;
      Step;
      DataWidth := LastWidth;
    end;
    opDataWidth16: if DataWidth <> bw16 then begin
      LastWidth := DataWidth;
      DataWidth := bw16;
      Step;
      DataWidth := LastWidth;
    end;
    opAddressWidth8: if AddressWidth <> bw8 then begin
      LastWidth := AddressWidth;
      AddressWidth := bw8;
      Step;
      AddressWidth := LastWidth;
    end;
    opAddressWidth16: if AddressWidth <> bw16 then begin
      LastWidth := AddressWidth;
      AddressWidth := bw16;
      Step;
      AddressWidth := LastWidth;
    end;
  end;
end;

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

constructor TCpu.Create;
begin
end;

destructor TCpu.Destroy;
begin
  inherited;
end;

procedure TCpu.AssignValue(var Dest: TValue; Source: TValue; Width: TBitWidth);
begin
  case Width of
    bw8: Dest.Value8 := Source.Value8;
  end;
end;

end.