source: trunk/Debugger.pas

unit Debugger;

interface

uses
  Classes, SysUtils, Generics.Collections, Generics.Defaults, Z80, Disassembler;

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

  { TBreakPoints }

  TBreakPoints = class(TList<Word>)
  private
    function Comparer(constref Left, Right: Word): Integer;
  public
    function Contains(Address: Word): Boolean;
    procedure AddNew(Address: Word);
  end;

  TCallStack = class;

  { TCallStackItem }

  TCallStackItem = class
  private
    FCommentDecoded: Boolean;
    FComment: string;
    function GetComment: string;
  public
    CallStack: TCallStack;
    Address: Word;
    Value: Word;
    property Comment: string read GetComment;
  end;

  { TCallStack }

  TCallStack = class(TObjectList<TCallStackItem>)
    Disassembler: TDisassembler;
    function AddNew(Address: Word): TCallStackItem;
  end;

  { TDebugger }

  TDebugger = class
  private
    FCpu: TCpuZ80;
    FDisassembler: TDisassembler;
    FOnChange: TNotifyEvent;
    procedure Pause;
    procedure SetCpu(AValue: TCpuZ80);
    procedure CpuCall(Address: Word);
    procedure CpuReturn;
    procedure CpuStep;
    procedure DoOnChange;
    procedure SetDisassembler(AValue: TDisassembler);
  public
    BreakPoints: TBreakPoints;
    DebugMode: TDebugMode;
    DebugStopAddress: Word;
    CallStack: TCallStack;
    procedure Reset;
    constructor Create;
    destructor Destroy; override;
    property Cpu: TCpuZ80 read FCpu write SetCpu;
    property Disassembler: TDisassembler read FDisassembler write SetDisassembler;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;


implementation

{ TDebugger }

procedure TDebugger.SetCpu(AValue: TCpuZ80);
begin
  if FCpu = AValue then Exit;
  if Assigned(FCpu) then begin
    FCpu.OnCall := nil;
    FCpu.OnReturn := nil;
    FCpu.OnStep := nil;
  end;
  FCpu := AValue;
  if Assigned(FCpu) then begin
    FCpu.OnCall := CpuCall;
    FCpu.OnReturn := CpuReturn;
    FCpu.OnStep := CpuStep;
  end;
end;

procedure TDebugger.CpuCall(Address: Word);
begin
  CallStack.AddNew(Address);
  if DebugMode = dmStepOver then begin
    DebugStopAddress := Cpu.PC;
    DebugMode := dmStopAddress;
  end;
  DoOnChange;
end;

procedure TDebugger.CpuReturn;
begin
  if CallStack.Count > 0 then CallStack.Delete(CallStack.Count - 1);
  if DebugMode = dmStepOut then begin
    Cpu.Paused := True;
    DebugMode := dmNone;
  end;
  DoOnChange;
end;

procedure TDebugger.Pause;
begin
  DebugMode := dmNone;
  Cpu.Paused := True;
  DoOnChange;
end;

procedure TDebugger.CpuStep;
begin
  if DebugMode <> dmNone then begin
    if DebugMode = dmStepIn then begin
      Pause;
    end;
    if (DebugMode = dmStopAddress) and (DebugStopAddress = Cpu.PC) then begin
      Pause;
    end;
    if DebugMode = dmStepOver then begin
      Pause;
    end;
  end;
  if BreakPoints.Contains(Cpu.PC) then begin
    Pause;
  end;
  DoOnChange;
end;

procedure TDebugger.DoOnChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TDebugger.SetDisassembler(AValue: TDisassembler);
begin
  if FDisassembler = AValue then Exit;
  FDisassembler := AValue;
  CallStack.Disassembler := AValue;
end;

procedure TDebugger.Reset;
begin
  BreakPoints.Clear;
  CallStack.Clear;
end;

constructor TDebugger.Create;
begin
  BreakPoints := TBreakPoints.Create(TComparer<Word>.Construct(TBreakPoints.Comparer));
  CallStack := TCallStack.Create;
end;

destructor TDebugger.Destroy;
begin
  FreeAndNil(CallStack);
  FreeAndNil(BreakPoints);
  inherited;
end;

{ TBreakPoints }

function TBreakPoints.Comparer(constref Left, Right: Word): Integer;
begin
  if Left > Right then Result := 1
  else if Left < Right then Result := -1
  else Result := 0;
end;

function TBreakPoints.Contains(Address: Word): Boolean;
var
  Index: SizeInt;
begin
  if (Count > 0) and BinarySearch(Address, Index) then begin
    Result := True;
  end else Result := False;
end;

procedure TBreakPoints.AddNew(Address: Word);
begin
  Add(Address);
  Sort;
end;

{ TCallStackItem }

function TCallStackItem.GetComment: string;
var
  Instruction: TDecodedInstruction;
begin
  if not FCommentDecoded then begin
    Instruction := CallStack.Disassembler.DecodedInstructions.SearchAddress(Address);
    if Assigned(Instruction) then
      FComment := Instruction.Comment;
    FCommentDecoded := True;
  end;
  Result := FComment;
end;

{ TCallStack }

function TCallStack.AddNew(Address: Word): TCallStackItem;
begin
  Result := TCallStackItem.Create;
  Result.Address := Address;
  Result.CallStack := Self;
  Add(Result);
end;


end.