source: trunk/CpuZ80.pas

unit CpuZ80;

interface

uses
  Classes, SysUtils, Memory;

type
  TReadEvent = function (Address: Word): Byte of object;
  TWriteEvent = procedure (Address: Word; Data: Byte) of object;

  TInstruction = (inNop = 0, inLdBcNn = $1, inLdBcIndirectA = $2,
    inIncBc = $3, inIncB = $4, inDecB = $5, inLdBN = $6, inRlca = $7,
    inLdDeNn = $11, inJrNzD = $20, inLdHlNn = $21,
    inIncHl = $23, inLdHlIndirectNn = $2a, inDecHl = $2b, inJrNcD = $30,
    inLdSpNn = $31, inLdNnIndirectA = $32, inLdHlIndirectN = $36, inLdAN = $3e,
    inLdCHlIndirect = $4e,
    inLdHlIndirectD = $72, inLdHlIndirectE = $73, inHalt = $76, inLdAC = $79,
    inLdAHlIndirect = $7e,
    inXorA = $af, inCpD = $ba, inCpE = $bb,
    inJpNn = $c3, inPushBc = $c5, inRst00 = $c7, inRet = $c9, inJpZNn = $ca, inPrefixCb = $cb,
    inCallNn = $cd, inRst08 = $cf,
    inOutNA = $d3, inPushDe = $d5, inRst10 = $d7, inPrefixDd = $dd,
    inRst18 = $df, inRst20 = $e0, inPushHl = $e5, inExDeHl = $eb,
    inPrefixEd = $ed, inRst28 = $ef, inDi = $f3,
    inRst30 = $f7, inEi = $fb, inPrefixFd = $fd, inCpN = $fe,
    inRst38 = $ff, inSbcHlDe = $ed52, inIm1 = $ed56);

  TCpuZ80 = class;

  { TCpuThread }

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

  TRegBC = record
    case Byte of
      0: (B, C: Byte);
      1: (Value: Word);
  end;

  TRegDE = record
    case Byte of
      0: (D, E: Byte);
      1: (Value: Word);
  end;

  TRegHL = record
    case Byte of
      0: (H, L: Byte);
      1: (Value: Word);
  end;

  TDebugMode = (dmNone, dmStepIn, dmStepOut, dmStepOver, dmStopAddress);

  { TCpuZ80 }

  TCpuZ80 = class
  private
    FOnInput: TReadEvent;
    FOnOutput: TWriteEvent;
    FOnRead: TReadEvent;
    FOnWrite: TWriteEvent;
    FRunning: Boolean;
    FThread: TCpuThread;
    Instruction: TInstruction;
    procedure SetRunning(AValue: Boolean);
    function DoRead(Address: Word): Byte;
    procedure DoWrite(Address: Word; Data: Byte);
    function DoInput(Address: Word): Byte;
    procedure DoOutput(Address: Word; Data: Byte);
    function ReadByte: Byte;
    function ReadWord: Word;
    procedure PushWord(Data: Word); inline;
    function PopWord: Word; inline;
    procedure Call(Address: Word); inline;
    procedure Cp(Data: Byte); inline;
    procedure Jr(Condition: Boolean); inline;
    procedure Jp(Condition: Boolean); inline;
  public
    A: Byte;
    PC: Word;
    SP: Word;
    BC: TRegBC;
    DE: TRegDE;
    HL: TRegHL;
    Carry: Boolean;
    Zero: Boolean;
    Memory: TMemory;
    Ticks: Cardinal;
    InterruptEnabled: Boolean;
    InterruptMode: Byte;
    DebugMode: TDebugMode;
    DebugStopAddress: Word;
    procedure Step;
    procedure Reset;
    constructor Create;
    destructor Destroy; override;
    property Running: Boolean read FRunning write SetRunning;
    property OnRead: TReadEvent read FOnRead write FOnRead;
    property OnWrite: TWriteEvent read FOnWrite write FOnWrite;
    property OnInput: TReadEvent read FOnInput write FOnInput;
    property OnOutput: TWriteEvent read FOnOutput write FOnOutput;
  end;

implementation

{ TCpuThread }

procedure TCpuThread.Execute;
begin
  while not Terminated do begin
    Cpu.Step;
    if Cpu.DebugMode <> dmNone then begin
      if Cpu.DebugMode = dmStepIn then Terminate;
      if (Cpu.DebugMode = dmStopAddress) and (Cpu.DebugStopAddress = Cpu.PC) then
        Terminate;
      Cpu.DebugMode := dmNone;
    end;
  end;
  Cpu.FRunning := False;
end;

{ TCpuZ80 }

procedure TCpuZ80.SetRunning(AValue: Boolean);
begin
  if FRunning = AValue then Exit;
  if FRunning then begin
    FThread.Terminate;
    FThread.WaitFor;
    FreeAndNil(FThread);
  end;
  FRunning := AValue;
  if FRunning then begin
    if Assigned(FThread) then FThread.Free;
    FThread := TCpuThread.Create(True);
    FThread.FreeOnTerminate := False;
    FThread.Cpu := Self;
    FThread.Start;
  end;
end;

function TCpuZ80.DoRead(Address: Word): Byte;
begin
  if Assigned(FOnRead) then Result := FOnRead(Address);
end;

procedure TCpuZ80.DoWrite(Address: Word; Data: Byte);
begin
  if Assigned(FOnRead) then FOnWrite(Address, Data);
end;

function TCpuZ80.DoInput(Address: Word): Byte;
begin
  if Assigned(FOnInput) then Result := FOnInput(Address);
end;

procedure TCpuZ80.DoOutput(Address: Word; Data: Byte);
begin
  if Assigned(FOnOutput) then FOnOutput(Address, Data);
end;

function TCpuZ80.ReadByte: Byte;
begin
  Result := DoRead(PC);
  PC := (PC + SizeOf(Byte)) mod $10000;
end;

function TCpuZ80.ReadWord: Word;
begin
  Result := DoRead(PC) or (DoRead(PC + 1) shl 8);
  PC := (PC + SizeOf(Word)) mod $10000;
end;

procedure TCpuZ80.PushWord(Data: Word);
begin
  SP := (SP + $10000 - SizeOf(Word)) mod $10000;
  DoWrite(SP, Data and $ff);
  DoWrite(SP + 1, Data shr 8);
end;

function TCpuZ80.PopWord: Word;
begin
  Result := DoRead(SP) or (DoRead(SP + 1) shl 8);
  SP := (SP + SizeOf(Word)) mod $10000;
end;

procedure TCpuZ80.Call(Address: Word);
begin
  PushWord(PC);
  PC := Address;
end;

procedure TCpuZ80.Cp(Data: Byte);
var
  TempByte: Byte;
begin
  Carry := Data > A;
  TempByte := Byte(ShortInt(A) - ShortInt(Data));
  Zero := TempByte = 0;
end;

procedure TCpuZ80.Jr(Condition: Boolean);
var
  Temp: Byte;
begin
  Temp := ReadByte;
  if Condition then
    PC := PC + ShortInt(Temp);
end;

procedure TCpuZ80.Jp(Condition: Boolean);
var
  Temp: Word;
begin
  Temp := ReadWord;
  if Condition then PC := Temp;
end;

procedure TCpuZ80.Step;
var
  Opcode: Byte;
  TempWord: Word;
begin
  Opcode := ReadByte;
  if Opcode = $cb then begin
    Opcode := ReadByte;
    Instruction := TInstruction($cb00 or Opcode)
  end
  else if Opcode = $dd then begin
    Opcode := ReadByte;
    Instruction := TInstruction($dd00 or Opcode)
  end
  else if Opcode = $ed then begin
    Opcode := ReadByte;
    Instruction := TInstruction($ed00 or Opcode)
  end
  else if Opcode = $fd then begin
    Opcode := ReadByte;
    Instruction := TInstruction($fd00 or Opcode)
  end
  else Instruction := TInstruction(Opcode);
  case Instruction of
    inNop: ;
    inHalt: ;
    inLdHlNn: HL.Value := ReadWord;
    inLdBcNn: BC.Value := ReadWord;
    inLdDeNn: DE.Value := ReadWord;
    inLdSpNn: SP := ReadWord;
    inLdAN: A := ReadByte;
    inLdBN: BC.B := ReadByte;
    inLdAC: A := BC.C;
    inLdHlIndirectN: DoWrite(HL.Value, ReadByte);
    inLdNnIndirectA: DoWrite(ReadWord, A);
    inLdHlIndirectD: DoWrite(HL.Value, DE.D);
    inLdHlIndirectE: DoWrite(HL.Value, DE.E);
    inLdCHlIndirect: BC.C := DoRead(HL.Value);
    inLdAHlIndirect: A := DoRead(HL.Value);
    inLdBcIndirectA: DoWrite(BC.Value, A);
    inLdHlIndirectNn: begin
      TempWord := ReadWord;
      DoWrite(HL.Value, TempWord and $ff);
      DoWrite(HL.Value + 1, TempWord shr 8);
    end;
    inJpNn: PC := ReadWord;
    inJpZNn: Jp(not Zero);
    inCpN: Cp(ReadByte);
    inCpD: Cp(DE.D);
    inCpE: Cp(DE.E);
    inCallNn: begin
      TempWord := ReadWord;
      if DebugMode = dmStepOver then begin
        DebugStopAddress := PC;
        DebugMode := dmStopAddress;
      end;
      Call(TempWord);
    end;
    inRet: begin
      PC := PopWord;
      if DebugMode = dmStepOut then begin
        FThread.Terminate;
        DebugMode := dmNone;
      end;
    end;
    inRst00: Call($00);
    inRst08: Call($08);
    inRst10: Call($10);
    inRst18: Call($18);
    inRst20: Call($20);
    inRst28: Call($28);
    inRst30: Call($30);
    inRst38: Call($08);
    inDi: InterruptEnabled := False;
    inEi: InterruptEnabled := True;
    inIm1: InterruptMode := 1;
    inOutNA: DoOutput(ReadByte, A);
    inXorA: A := A xor A;
    inPushBc: PushWord(BC.Value);
    inPushDe: PushWord(DE.Value);
    inPushHl: PushWord(HL.Value);
    inSbcHlDe: HL.Value := HL.Value - DE.Value;
    inExDeHl: begin
      TempWord := DE.Value;
      DE.Value := HL.Value;
      HL.Value := TempWord;
    end;
    inDecHl: Dec(HL.Value);
    inIncHl: Inc(HL.Value);
    inIncBc: Inc(BC.Value);
    inIncB: Inc(BC.B);
    inDecB: Dec(BC.B);
    inJrNzD: Jr(not Zero);
    inJrNcD: Jr(not Carry);
    else raise Exception.Create('Unsupported instruction ' + IntToHex(Word(Instruction), 4));
  end;
  Ticks := Cardinal(Ticks + 1);
end;

procedure TCpuZ80.Reset;
begin
  A := 0;
  PC := 0;
  BC.Value := 0;
  DE.Value := 0;
  HL.Value := 0;
  SP := 0;
  Carry := False;
  Zero := False;
  InterruptEnabled := True;
  InterruptMode := 0;
end;

constructor TCpuZ80.Create;
begin
  Reset;
end;

destructor TCpuZ80.Destroy;
begin
  Running := False;
  inherited;
end;

end.